[SOLVED:] Match and then Copy/Paste based on dates

2 Attachment(s)

Match and then Copy/Paste based on dates

What I would like to do is put in a Dept Code in B1 on my Summary doc, find said Dept Code in my Call Placement doc and then bring back the months' data and paste into the appropriate months' column(s) on the Summary doc.

I've created a Worksheet_Change sub on the doc but not sure how to get started copying/pasting the data from one doc to another. The issue I can't seem to overcome is that the number of columns in the Work Placement document could change depending on the current month. For instance if it's December 2024, it'll just have 1 column. If it's January 2024, it'll have 12... and anywhere in between.

Any help anyone could provide would be appreciated.

Welcome to VBAX Wheelie686. Would it be possible to filter your data based on Dept Code?

2 Attachment(s)

Hi Aussiebear,
There's an automatic macro that'll trigger if you have both files open and type a proper code in B1 on the Summary doc. Here's what it would look like with code 1501. I added "v2" to the title so you can differentiate if you want.

Perhaps you could try it without using filter:

Code:

Private Sub Worksheet_Change(ByVal Target As Range) Dim wb As Workbook Dim YEE As Workbook Dim ws As Worksheet Dim uCols As Integer Dim sMnth As Date Dim dRng As Range For Each wb In Workbooks If wb.Name Like "YEE*call placement*" Then Set YEE = wb Exit For End If Next wb If Target.Address = "$B$1" Then For Each ws In YEE.Worksheets If ws.Name Like "YEE*DEPT*" Then uCols = ws.UsedRange.Columns.Count sMnth = ws.Range("B1").Value Set dRng = ws.Range("A:A").Find(Target.Value, , , xlWhole) Range("B4:Y4").ClearContents dRng.Offset(, 1).Resize(, uCols - 2).Copy Rows(3).Find(sMnth, , , xlWhole).Offset(1).PasteSpecial xlValues Application.CutCopyMode = False End If Next ws End If End Sub

2 Attachment(s)

So it looks perfect except when I tried to transfer it to my "official" document - I had used more of a template that had sensitive info removed. The trouble comes up because some of my rows/columns don't quite match what I had sent you before. I believe I fixed everything but the Copy line. Based on the attached documents, would you be able to advise how to modify the code? As you can see, it's pulling June to December PLUS Column N (and maybe a few blank columns).

Maybe you could try it as below then:

Code:

Private Sub Worksheet_Change(ByVal Target As Range) Dim wb As Workbook Dim YEE As Workbook Dim ws As Worksheet Dim uCols As Integer Dim sMnth As Date Dim dRng 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 Target.Address = "$B$4" Then For Each ws In YEE.Worksheets If ws.Name Like "YEE*MU*" Then uCols = ws.UsedRange.Columns.Count sMnth = ws.Range("G1").Value Set dRng = ws.Range("F:F").Find(Target.Value, , , xlWhole) Range("B10:Y10").ClearContents ws.Range(ws.Cells(dRng.Row, dRng.Column + 1), ws.Cells(dRng.Row, uCols - 1)).Copy Rows(9).Find(sMnth, , , xlWhole).Offset(1).PasteSpecial xlValues Application.CutCopyMode = False Exit For End If Next ws End If Application.EnableEvents = True End Sub

Perfect! Now I see what I did wrong. Thanks!

Happy to help.

Here is another option without using copy/ paste:

Code:

Private Sub Worksheet_Change(ByVal Target As Range) 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 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 Target.Address = "$B$4" Then For Each ws In YEE.Worksheets If ws.Name Like "YEE*MU*" Then uCols = ws.UsedRange.Columns.Count sMnth = ws.Range("G1").Value Set dRng = ws.Range("F:F").Find(Target.Value, , , xlWhole) Range("B10:Y10").ClearContents Set cRng = ws.Range(ws.Cells(dRng.Row, dRng.Column + 1), ws.Cells(dRng.Row, uCols - 1)) Rows(9).Find(sMnth, , , xlWhole).Offset(1).Resize(, cRng.Columns.Count) = cRng.Value Exit For End If Next ws End If Application.EnableEvents = True End Sub

After testing it on & off this morning, I did notice something that I didn't expect to happen - if I end up triggering the macro without having the Call Placement file open (not that that would happen much but running a separate macro ended up triggering it). Once it tries to trigger without the Call Placement file, if I try to purposely trigger it, it just sits there doing nothing. It will only work if I re-open both files. Not a huge hassle but definitely not what I expected.
I think my better option would be to just make it a regular macro that I trigger with a button - I already have 3 others so adding a 4th button wouldn't be the end of the world for me.
Would you know how to switch it to a regular macro? I have the following but the line I put in bold comes back with a runtime 424 error.

Code:

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 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 Target.Address = "$B$4" Then For Each ws In YEE.Worksheets If ws.Name Like "YEE*MU*" Then uCols = ws.UsedRange.Columns.Count sMnth = ws.Range("G1").Value Set dRng = ws.Range("F:F").Find(Target.Value, , , xlWhole) Range("B10:Y10").ClearContents ws.Range(ws.Cells(dRng.Row, dRng.Column + 1), ws.Cells(dRng.Row, uCols - 1)).Copy Rows(9).Find(sMnth, , , xlWhole).Offset(1).PasteSpecial xlValues Application.CutCopyMode = False Exit For End If Next ws 'End If ThisWorkbook.Sheets("YEE").Range("B4").Select Application.EnableEvents = True End Sub

You can still run it the way it was originally, I have added some error handling in the below to check if the call placement spreadsheet is open:

Code:

Private Sub Worksheet_Change(ByVal Target As Range) 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 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 If Target.Address = "$B$4" Then For Each ws In YEE.Worksheets If ws.Name Like "YEE*MU*" Then uCols = ws.UsedRange.Columns.Count sMnth = ws.Range("G1").Value Set dRng = ws.Range("F:F").Find(Target.Value, , , xlWhole) Range("B10:Y10").ClearContents Set cRng = ws.Range(ws.Cells(dRng.Row, dRng.Column + 1), ws.Cells(dRng.Row, uCols - 1)) Rows(9).Find(sMnth, , , xlWhole).Offset(1).Resize(, cRng.Columns.Count) = cRng.Value Exit For End If Next ws End If Application.EnableEvents = True End Sub

As for other subs triggering your worksheet event, you can disable events in those macro's using the below method. It will stop them from triggering events when they make changes to the worksheet:

Code:

Sub test() Application.EnableEvents = False ' Your code here ' Your code here ' Your code here Application.EnableEvents = True End Sub

For each of your other subs that interact with the sheet with the event code you would add the false line from above test macro, run all of your code, then use the true line from above test macro.

As for post 9, In your bold line.

Code:

Set dRng = ws.Range("F:F").Find(Target.Value, , , xlWhole)

This:

Code:

Target.Value

would need to be replaced with something like:

Code:

Range("B4").Value

I can't thank you enough for the help on this. To be honest I didn't want to abandon the Worksheet_Change function so getting the error handling right wasn't something I thought of but I'm not as well versed in doing that so I appreciate your help. This will help me learn some things about VBA that I wasn't quite getting right.