create a summary

[Ger]

Good morning,

i'm looking for a way to create a summary.
I've a list of date that a person followed a training and a list of persons that must follow the training.
i'm looking for a way to copy the date a training (gegevens) to the list of persons (ovz).

Keyfield is pers.nr.

see attachment.


Thx,
Ger

[SamT]

Sub TransferDates()
'for help, see: "http://www.vbaexpress.com/forum/showthread.php?53527-create-a-summary"
Dim GegPersNr As Range
Dim OvzPersNr As Range
Dim Cel As Range

Set GegPersNr = Sheets("gegevens").Range(Range("A2"), Range("A2").End(xlDown)) 
Set OvzPersNr = Sheets("ovz").Range(Range("A2"), Range("A2").End(xlDown))

OnError GoTo Message

For Each Cel In GegPersNr
  Cel.Offset(0, 1).Copy OvzPersNr.Find(Cel).End(xlToRight)
Next Cel

Exit Sub
Message:
MsgBox "Pers.Nr " & Cel.Value & "  not found " 

End Sub

[Ger]

SamT,

error message on set GegPersNr.


Ger

[Ger]

Sub TransferDates()
     'for help, see: "http://www.vbaexpress.com/forum/show...eate-a-summary"
    Dim GegPersNr As Range
    Dim OvzPersNr As Range
    Dim Cel As Range
    Set Sh = Sheets("gegevens")
    Set Sh2 = Sheets("ovz")
    Set GegPersNr = Sh.Range("A2:A24")
    Set OvzPersNr = Sh2.Range("A2:A16")
     
    On Error GoTo Message
     
    For Each Cel In GegPersNr
        Cel.Offset(0, 1).Copy OvzPersNr.Find(Cel).End(xlToRight)
    Next Cel
     
    Exit Sub
Message:
    MsgBox "Pers.Nr " & Cel.Value & "  not found "
     
End Sub

This code runs but copies only 1 date (the last) to each persnr in ovz in column c and not date 1 to column d, date 2 to column e, date 3 to column f etc.

Ger

[snb]

@Ger,

Volgens mij kun je veel eenvoudiger op helpmij.nl je vraag stellen.

[Ger]

zal ik doen.

[snb]

Sub M_snb()
   sn = Sheets("gegevens").Cells(1).CurrentRegion
   sp = Sheets("ovz").Cells(1).CurrentRegion
   
   With CreateObject("scripting.dictionary")
     For j = 2 To UBound(sn)
        .Item(sn(j, 1)) = .Item(sn(j, 1)) & "_" & sn(j, 2)
     Next
     
     For j = 2 To UBound(sp)
       If .exists(sp(j, 1)) Then Sheets("ovz").Cells(j, 4).Resize(, UBound(Split(.Item(sp(j, 1)), "_"))) = Split(Mid(.Item(sp(j, 1)), 2), "_")
     Next
  End With
End Sub

[Ger]

Snb,

Thx.
This works fine.


Ger
PS zal post in helpmij op afgehandeld zetten.

[SamT]

This code runs but copies only 1 date (the last) to each persnr in ovz in column c and not date 1 to column d, date 2 to column e, date 3 to column f etc.

I'm sorry, that was my bad for not fully testing it. It was copying all dates to the same column.

For Each Cel In GegPersNr 
        Cel.Offset(0, 1).Copy OvzPersNr.Find(Cel).End(xlToRight).Offset(0, 1)
    Next Cel