VBA rij kopieren met voorwaarde

[Driesumdre]

Goedemiddag helden van Excel,

Ik ben nieuw als het gaat om VBA, maar ik ben leergierig en ik wil dit graag onder de knie krijgen.
De basis is er in ieder geval, en vaak kom ik er wat zoekwerk, knippen en plakken wel uit.
Nu ben ik al een tijdje aan het prutsen met een VBA code, maar deze vraag is uitgebreid dat ik er niet uit kom.

Wat ik wil is een rij kopiëren van één blad en invoegen "plakken als waarde" op een ander blad als een veld in een kolom op ja gezet wordt.
De gebruiker moet middels MsgBox geïnformeerd worden van de actie en vervolgens moet er in de originele rij het een en ander veranderd worden.

Bekijk bijlage Kalibratie test.xls hier is het bestand.

Ik heb voor het gemak in blad "wat ik wil" stap voor stap uitgelegd wat er moet gebeuren.
Zouden jullie aan kunnen geven wat je waarom doet? ('uitlegtekst in VBA)
Ik wil hier ook echt iets van kunnen leren en dát zou erg handig zijn.

Alvast bedankt voor jullie hulp!

Groeten, André

 

[spaarie]

Is dit wat?
Als je enige uitleg wilt kan je het krijgen, maar denk dat het aardig voor zich spreekt....

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column = 11 Then
        If Target.Value = "Ja" Then
            Target.Offset(0, 1).Value = Date
            
            certificaat = Application.InputBox("Geef certificaatnummer in:", "Certificaat")
            If certificaat = "" Then
                MsgBox "U heeft geen nummer ingevuld, probeer opnieuw.", vbInformation + vbOKOnly, "Fout"
                Exit Sub
                Target.Value = "Nee"
            Else
                Target.Offset(, -3) = certificaat
            End If
            
            Range(Cells(Target.Row, 1), Cells(Target.Row, 12)).Copy
            With Sheets("Kalibratie_data")
                .Range("A" & .Range("A" & Rows.Count).End(xlUp).Offset(1).Row).PasteSpecial xlValues
                .UsedRange.Offset(2).Sort .Range("I2"), xlAscending
            End With
            
            Application.Goto Cells(1)
            Cells(Target.Row, 9) = Cells(Target.Row, 12)
            Target.Value = "Nee"
        Else: Target.Offset(0, 1).Value = ""
        End If
    End If
End Sub

 

[Driesumdre]

Goedemiddag Spaari,

Bedankt voor je snelle reactie.

Komt in de buurt, maar de volgorde klopt nu niet, hij moet eerst de regel overbrengen en dan de vraag certificaat geven.
(e.e.a. omdat het certificaat geldig is voor de nieuwe periode tot de volgende Kalibratie)

Daarnaast zou ik graag de opties volgt en nvt toe willen voegen.
- soms is er geen certificaat.
- vaak duurt het even voordat het Certificaat binnen is. (Terwijl de datum van kalibratie wel vast moet staan aangezien de nieuwe kalibratiedata hierop moet worden gebaseerd.)

Misschien is het handiger/praktischer om naast het certificaat ook te vragen naar kalibratiedatum en deze datum in kolom "Voltooid op" te plaatsen.
de msgbox zou dan <Certificaatnummer aanwezig?> 3 knoppen moeten bevatten:
<[JA] vervolgens invullen certificaatnummer (->naar kolom H) en kalibratiedatum(->naar kolom 12)><na invullen melding: "Kalibratie-data wordt verwerkt">
<[volgt] melding: "Wacht met afmelden tot het certificaat is ontvangen">,
<[NVT] melding: "Kalibratie-data wordt verwerkt">

Denk je dat dit ook mogelijk is?

Alvast bedankt,

André

 

[Driesumdre]

Hallo,

Ik ben een beetje gaan verschuiven om de volgorde voor elkaar te krijgen.

Ik heb het onderstaande er van gemaakt:

Private Sub Worksheet_Change(ByVal Target As Range)
    
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
    
      If Target.Column = 11 Then
        If Target.Value = "Ja" Then
            Target.Offset(0, 1).Value = Date
            
            Range(Cells(Target.Row, 1), Cells(Target.Row, 12)).Copy
            
            Beep
            certificaat = Application.InputBox("Geef certificaatnummer in:", "Certificaat")
            If certificaat = "" Then
                MsgBox "U heeft geen nummer ingevuld, probeer opnieuw.", vbInformation + vbOKOnly, "Fout"
                Exit Sub
                Target.Value = "Nee"
                Target.Offset(0, 1).Value = ""
                
            Else
                Target.Offset(0, -3) = certificaat
                MsgBox "De kalibratiedata is bijgewerkt.", vbOKOnly
            End If
            
            With Sheets("Kalibratie_data")
                .Range("A" & .Range("A" & Rows.Count).End(xlUp).Offset(1).Row).PasteSpecial xlValues
                .UsedRange.Offset(2).Sort .Range("I2"), xlAscending
            End With
            
            Application.Goto Cells(1)
            Cells(Target.Row, 9) = Cells(Target.Row, 12)
            Target.Value = "Nee"
            Target.Offset(0, 1).Value = ""
        End If
        End If
        
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With

End Sub

Met bovenstaande code ontstaan de volgende problemen.
Indien in "Certificaat" niets wordt ingevoerd, geeft hij de melding "probeer opnieuw" maar helaas blijft de code hangen en lukt het niet om nogmaals de makro te starten.
Indien er wel een certificaatnummer wordt ingevoerd krijg ik foutmelding: Fout 1004 tijdens uitvoering: methode PasteSpecial van klasse range is mislukt.
Het probleem schuilt in deze regel: .Range("A" & .Range("A" & Rows.Count).End(xlUp).Offset(1).Row).PasteSpecial xlValues

Weet iemand wat ik niet goed doe?
PS liefst zou ik werken met het format zoals in mijn eerdere bericht (16 augustus 2013, 13:27 ), maar misschien vraag ik dan te veel.

Groetjes, André

 

[spaarie]

André,

Probeer deze eens...

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column = 11 Then
        If Target.Value = "Ja" Then
            If MsgBox("Heeft u een certificaatnummer?", vbYesNo + vbInformation, "Nummer") = vbYes Then
                certificaat = Application.InputBox("Geef certificaatnummer in:", "Certificaat")
                If certificaat = "" Then
                    MsgBox "U heeft geen nummer ingevuld, probeer opnieuw.", vbInformation + vbOKOnly, "Fout"
                    Exit Sub
                    Target.Value = "Nee"
                Else
                    Target.Offset(, -3) = certificaat
                End If
            Else
                If MsgBox("Volgt deze nog?", vbInformation + vbYesNo, "Toepassing") = vbYes Then
                    Target.Offset(, -3) = "Volgt"
                Else: Target.Offset(, -3) = "N.V.T"
                End If
            End If
            
            Do Until datum <> ""
            datum = Application.InputBox("Wat is de kalibratiedatum?", "Datum")
            Loop
            
            Target.Offset(, 1) = DateValue(Format(datum, "dd-mm-yyyy"))
            
            Range(Cells(Target.Row, 1), Cells(Target.Row, 12)).Copy
            With Sheets("Kalibratie_data")
                .Range("A" & .Range("A" & Rows.Count).End(xlUp).Offset(1).Row).PasteSpecial xlValues
                .UsedRange.Offset(2).Sort .Range("I2"), xlAscending
            End With
            
            Application.Goto Cells(1)
            Cells(Target.Row, 9) = Cells(Target.Row, 12)
            Target.Value = "Nee"
        Else: Target.Offset(0, 1).Value = ""
        End If
    End If
End Sub

 

[Driesumdre]

Spaarie,

Dit ziet er goed uit, daar wordt ik blij van!
Toch nog wel een maar-tje: de volgorde is nog niet ok.
Op het moment van kopiëren / plakken is het certificaatnummer al gewijzigd, en wordt dus ook mee gekopieerd naar de "Kalibratiedata"
Dat moet eigenlijk niet. Dit moet hen cert. nummer zijn wat er in stond, want die was geldig tot de nieuwe kalibratie.

Heb je een manier om dit voor elkaar te krijgen?
Alvast bedankt,

Groetjes, André

 

[spaarie]

Hoop dat het maar-tje eruit is nu:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column = 11 Then
        If Target.Value = "Ja" Then
            If MsgBox("Heeft u een certificaatnummer?", vbYesNo + vbInformation, "Nummer") = vbYes Then
                Do Until certificaat <> ""
                certificaat = Application.InputBox("Geef certificaatnummer in:", "Certificaat")
                Loop
            Else
                If MsgBox("Volgt deze nog?", vbInformation + vbYesNo, "Toepassing") = vbYes Then
                    certificaat = "Volgt"
                Else: certificaat = "N.V.T"
                End If
            End If
            
            Do Until datum <> ""
            datum = Application.InputBox("Wat is de kalibratiedatum?", "Datum")
            Loop
            
            Target.Offset(, 1) = DateValue(Format(datum, "dd-mm-yyyy"))
            
            Range(Cells(Target.Row, 1), Cells(Target.Row, 12)).Copy
            With Sheets("Kalibratie_data")
                .Range("A" & .Range("A" & Rows.Count).End(xlUp).Offset(1).Row).PasteSpecial xlValues
                .UsedRange.Offset(2).Sort .Range("I2"), xlAscending
            End With
            
            Application.Goto Cells(1)
            Cells(Target.Row, 9) = Cells(Target.Row, 12)
            Target.Offset(, -3) = certificaat
            Target.Value = "Nee"
        Else: Target.Offset(0, 1).Value = ""
        End If
    End If
End Sub

offtopic: Mag ik vragen waar je gebruikersnaam op gebasseerd is i.c.m. je eigen naam?

 

[Driesumdre]

Goedemorgen Spaarie,

Fantastisch! Doet helemaal wat 'ie moet doen.
Super bedankt voor je hulp! Erg leerzaam!

Groeten, André