Match and then Copy/Paste based on dates

[Wheelie686]

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.

[Aussiebear]

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

[Wheelie686]

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.

[georgiboy]

Perhaps you could try it without using filter:

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

[Wheelie686]

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).

[georgiboy]

Maybe you could try it as below then:

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

[Wheelie686]

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

[georgiboy]

Happy to help.

Here is another option without using copy/ paste:

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

[Wheelie686]

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.

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

[georgiboy]

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:

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:

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.

[georgiboy]

As for post 9, In your bold line.

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

This:

Target.Value

would need to be replaced with something like:

Range("B4").Value

[Wheelie686]

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.