Waardes opzoeken via VBA

[Jatto]

Als ik een bepaalde waarde in een cel heb, wil ik via een userform met Optionbuttons
die waarde in een tabel zetten. Tevens moeten dan ook de waarde uit kolom1 van dezelfde regel, en de waarde van cel 1 van dezelfde kolom in een tabel gezet worden

Private Sub OptionButton1_Click()
 ActiveCell.Copy
 Sheets("Blad2").Select
 Range("C2").Select
 Do
 If IsEmpty(ActiveCell) = False Then
  ActiveCell.Offset(1, 0).Select
End If
 Loop Until IsEmpty(ActiveCell) = True
  ActiveCell.PasteSpecial (xlPasteValues)
   Sheets("Blad1").Select
UserForm1.Hide
End Sub

 

[Wigi]

Hang eens een simpel voorbeeldbestandje bij met fictieve data. En een duidelijke uitleg over wat het resultaat zou moeten zijn.

 

[Jatto]

Hierbij het voorbeeld.
De bedoeling voor week1:
Als de waarde van een actieve cel <> cel uit dezelfde kolom, rij 3 --> dan wordt een Userform geactiveerd. met dit Userform wordt de afwijking verantwoord (bepalen van juiste kolom op blad3) De waarde wil ik plakken in de tabel op blad3. Daarbij wil ik ook de naam uit de eerste kolom en de datum in de tabel plaatsen.

 

[Demeter]

Zet de volgende code onder blad1:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    
    If Not Intersect(Target, Range("B4:I14")) Is Nothing Then
        If Target.Value <> Cells(3, ActiveCell.Column).Value Then UserForm1.Show
    End If
    
    If Not Intersect(Target, Range("B19:I30")) Is Nothing Then
        If Target.Value <> Cells(19, ActiveCell.Column).Value Then UserForm1.Show
    End If
    
End Sub

Hiermee komt je userform naar voren als de gegevens in je bereiken niet voldoen aan de gegevens in je rooster rijen.

 

[Jatto]

Bedankt, stap 1 is opgelost.
Maar hoe kopieer je nu de veranderde waarde + de naam(kolom1) + de datum(rij 2 of 18) naar de tabel op blad3, en dan natuurlijk in de juiste kolom ? Het onderstaande werkt niet want dan ben ik de "focus" kwijt op de veranderde cel en kan ik de datum niet bepalen.

Private Sub OptionButton1_Click()
' Waarde van cel in kolom 3 van tabel plakken
ActiveCell.Copy
 Sheets("blad3").Select
  Range("c3").Select
Do
 If IsEmpty(ActiveCell) = False Then
  ActiveCell.Offset(1, 0).Select
End If
 Loop Until IsEmpty(ActiveCell) = True
    ActiveCell.PasteSpecial (xlPasteValues)
   
  ' Naam uit kolom 1 naar kolom 1 van tabel plakken
  
   Sheets("Blad1").Select
      Cells(ActiveCell.Row, 1).Copy
    Sheets("blad3").Select
     ActiveCell.Offset(, -2).Select
      ActiveCell.PasteSpecial (xlPasteValues)
   Sheets("Blad1").Select
UserForm1.Hide
End Sub

 

[Demeter]

Code is voor knop obVak (verander deze in je userform, ob staat voor ObjectButton)

Private Sub obVak_Click()
Dim legeregel As Long

'Bij veranderen tabnamen hoef je alleen de twee onderstaande regels aan te passen
Set MyRange1 = Sheets("Blad1")
Set MyRange2 = Sheets("Blad3")

    legeregel = MyRange2.Range("A65536").End(xlUp).Row + 1
    
    With MyRange2
        .Range("A" & legeregel) = MyRange1.Range("A" & ActiveCell.Row)
        .Range("B" & legeregel) = MyRange1.Cells(18, ActiveCell.Column).Value
        .Range("C" & legeregel) = MyRange1.Cells(18, ActiveCell.Column).Value
        .Select
    End With
    
UserForm1.Hide

End Sub

Kom er niet uit wat je nu precies in kolom C (of verder) wil plaatsen, vandaar dat ik daar nogmaals de datum laat zetten.

 

[Jatto]

Ik heb er het volgende van gemaakt voor Kolom C.

Private Sub OptionButton1_Click()
Dim legeregel As Long

'Bij veranderen tabnamen hoef je alleen de twee onderstaande regels aan te passen
 Set MyRange1 = Sheets("Blad1")
 Set MyRange2 = Sheets("Blad3")
    legeregel = MyRange2.Range("A65536").End(xlUp).Row + 1
    
    With MyRange2
        .Range("A" & legeregel) = MyRange1.Range("A" & ActiveCell.Row)
        .Range("B" & legeregel) = MyRange1.Cells(2, ActiveCell.Column).Value
        .Range("C" & legeregel) = ActiveCell.Offset(, 29).Value
        .Select
   End With
     Sheets("Blad1").Select
Unload Me
UserForm1.Hide

End Sub

Het werkt perfect, wederom weer bedankt.
Hulde aan het Forum

 

[Demeter]

Jatto,

.Select binnen de with functie kan je ook nog weg laten. Nu selecteer je pagina 3 en direct er na pagina 1 beetje te veel van het goede.

 

[Jatto]

Yep, weer helemaal gelijk.
Ik was zo blij met resultaat dat ik daar niet meer op gelet heb.
Thx.