Multiple Date matches

[Wheelie686]

I've got a VBA function that will look at the Dept code in A3 on Summary, find that code from the call placement doc and bring back the applicable months' data.
What I would like to do is repeat the same thing for A3 to A42 (or however far down Col A has data). I've made what I thought was the right changes but nothing happens beyond row 3. No error, it just doesn't go beyond the first Dept code.

Can anyone suggest the right change I need?

[Aussiebear]

Loop through each cell in Range(A3:A42) and carry out your required operation.

[georgiboy]

Maybe like the below?

Sub Test()
Dim wb As Workbook
Dim YEE As Workbook
Dim ws As Worksheet
Dim uCols As Integer
Dim sMnth As Date
Dim dRng As Range, cRng As Range, rCell As Range

Application.EnableEvents = False

For Each wb In Workbooks
If wb.Name Like "*YEE*call placement*" Then
Set YEE = wb
Exit For
End If
Next wb

If YEE Is Nothing Then
Application.EnableEvents = True
MsgBox "Call placement spreadsheet not open"
Exit Sub
End If

For Each ws In YEE.Worksheets
If ws.Name Like "YEE*MU*" Then
uCols = ws.UsedRange.Columns.Count
sMnth = ws.Range("G1").Value
For Each rCell In Range("A3:A42").Cells
Set dRng = ws.Range("F:F").Find(rCell.Value, , , xlWhole)
If Not dRng Is Nothing Then
Set cRng = ws.Range(ws.Cells(dRng.Row, dRng.Column + 1), ws.Cells(dRng.Row, uCols - 1))
Rows(2).Find(sMnth, , , xlWhole).Offset(rCell.Row - 2).Resize(, cRng.Columns.Count) = cRng.Value
End If
Next rCell
End If
Next ws

Application.EnableEvents = True
End Sub

[georgiboy]

To make it look to the bottom of column A and not just cell A42, change the below:

For Each rCell In Range("A3:A42").Cells
To:

For Each rCell In Range("A3:A" & Range("A" & Rows.Count).End(xlUp).Row).Cells

[Wheelie686]

Thank you georgiboy
So in my attempt to transplant it into another document, I failed to realize that the Summary file I originally uploaded has the chart in A1:T42 but I actually need it in BD1:BW42. The line that it highlights is the following. I changed the looped range from A3:A42 to BD3:B42 but I didn't think you'd have to change that line of code. I'm obviously wrong am I?


Rows(2).Find(sMnth, , , xlWhole).Offset(rCell.Row - 2).Resize(, cRng.Columns.Count) = cRng.Value

Again I appreciate your help while I try and teach myself some VBA.

[georgiboy]

A few bits that needed changing, see below:

Sub Test()
Dim wb As Workbook
Dim YEE As Workbook
Dim ws As Worksheet
Dim uCols As Integer
Dim sMnth As Date
Dim dRng As Range, cRng As Range, rCell As Range

Application.EnableEvents = False

For Each wb In Workbooks
If wb.Name Like "*YEE*call placement*" Then
Set YEE = wb
Exit For
End If
Next wb

If YEE Is Nothing Then
Application.EnableEvents = True
MsgBox "Call placement spreadsheet not open"
Exit Sub
End If

For Each ws In YEE.Worksheets
If ws.Name Like "YEE*MU*" Then
uCols = ws.UsedRange.Columns.Count
sMnth = ws.Range("G1").Value
For Each rCell In Range("BD3:BD" & Range("BD" & Rows.Count).End(xlUp).Row).Cells
Set dRng = ws.Range("F:F").Find(rCell.Value, , , xlWhole)
If Not dRng Is Nothing Then
Set cRng = ws.Range(ws.Cells(dRng.Row, dRng.Column + 1), ws.Cells(dRng.Row, uCols - 1))
Range(Range("BE2"), Range("BD2").End(xlToRight)).Find(Format(sMnth, "mmm-yy"), , xlValues, xlWhole).Offset(rCell.Row - 2).Resize(, cRng.Columns.Count) = cRng.Value
End If
Next rCell
End If
Next ws

Application.EnableEvents = True
End Sub

[Wheelie686]

With a few of my own tweeks, it works perfectly! One last question if you wouldn't mind.
Right now the table is A1:Y42. What would I need to do if say I wanted it to be moved down? Let's say I wanted it to be A14 instead of A1. So the Date row would be in row 15 instead of row 2.


Sub TEST()
Dim wb As Workbook
Dim YEE As Workbook
Dim ws As Worksheet
Dim uCols As Integer
Dim sMnth As Date
Dim dRng As Range, cRng As Range, rCell As Range

Application.EnableEvents = False

For Each wb In Workbooks
If wb.Name Like "*YEE*call placement*" Then
Set YEE = wb
Exit For
End If
Next wb


If YEE Is Nothing Then
Application.EnableEvents = True
MsgBox "Call placement spreadsheet not open"
Exit Sub
End If

For Each ws In YEE.Worksheets
If ws.Name Like "YEE*MU*" Then
uCols = ws.UsedRange.Columns.Count
sMnth = ws.Range("G1").Value
For Each rCell In Range("A3:A" & Range("A" & Rows.Count).End(xlUp).Row).Cells
Set dRng = ws.Range("F:F").Find(rCell.Value, , , xlWhole)
If Not dRng Is Nothing Then
Set cRng = ws.Range(ws.Cells(dRng.Row, dRng.Column + 1), ws.Cells(dRng.Row, uCols - 1))
Range(Range("B2"), Range("A2").End(xlToRight)).Find(Format(sMnth, "mmm-yy"), , xlValues, xlWhole).Offset(rCell.Row - 2).Resize(, cRng.Columns.Count) = cRng.Value
End If
Next rCell
End If
Next ws

Application.EnableEvents = True
End Sub

[georgiboy]

Right now the table is A1:Y42. What would I need to do if say I wanted it to be moved down?

Date row moved down on which workbook, 'Staff plan' or 'call placement'?

[Wheelie686]

ln Staff Plan

[georgiboy]

Perhaps like the below:

Sub Test()
Dim wb As Workbook
Dim YEE As Workbook
Dim ws As Worksheet
Dim uCols As Integer
Dim sMnth As Date
Dim dRng As Range, cRng As Range, rCell As Range, c As Long '<<< Added c variable

Application.EnableEvents = False

For Each wb In Workbooks
If wb.Name Like "*YEE*call placement*" Then
Set YEE = wb
Exit For
End If
Next wb


If YEE Is Nothing Then
Application.EnableEvents = True
MsgBox "Call placement spreadsheet not open"
Exit Sub
End If

For Each ws In YEE.Worksheets
If ws.Name Like "YEE*MU*" Then
uCols = ws.UsedRange.Columns.Count
sMnth = ws.Range("G1").Value
For Each rCell In Range("BD15:BD" & Range("BD" & Rows.Count).End(xlUp).Row).Cells
Set dRng = ws.Range("F:F").Find(rCell.Value, , , xlWhole)
If Not dRng Is Nothing Then
Set cRng = ws.Range(ws.Cells(dRng.Row, dRng.Column + 1), ws.Cells(dRng.Row, uCols - 1))
c = Range(Range("BE15"), Range("BE15").End(xlToRight)).Find(Format(sMnth, "mmm-yy"), , xlValues, xlWhole).Column '<<< Changed
Cells(rCell.Row, c).Resize(, cRng.Columns.Count) = cRng.Value '<<< Changed
End If
Next rCell
End If
Next ws

Application.EnableEvents = True
End Sub