View Full Version : [SOLVED:] create a summary
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
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
SamT,
error message on set GegPersNr.
Ger
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 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
@Ger,
Volgens mij kun je veel eenvoudiger op helpmij.nl je vraag stellen.
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
Snb,
Thx.
This works fine.
Ger
PS zal post in helpmij op afgehandeld zetten.
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
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.