Consulting

Results 1 to 12 of 12

Thread: Match and then Copy/Paste based on dates

  1. #1

    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.
    Attached Files Attached Files

  2. #2
    Moderator VBAX Wizard Aussiebear's Avatar
    Joined
    Dec 2005
    Location
    Queensland
    Posts
    5,180
    Location
    Welcome to VBAX Wheelie686. Would it be possible to filter your data based on Dept Code?
    Remember To Do the Following....
    Use [Code].... [/Code] tags when posting code to the thread.
    Mark your thread as Solved if satisfied by using the Thread Tools options.
    If posting the same issue to another forum please show the link

  3. #3
    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.
    Attached Files Attached Files

  4. #4
    Moderator VBAX Master georgiboy's Avatar
    Joined
    Mar 2008
    Location
    Kent, England
    Posts
    1,244
    Location
    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
    Click here for a guide on how to add code tags
    Click here for a guide on how to mark a thread as solved
    Click here for a guide on how to upload a file with your post

    Excel 365, Version 2405, Build 17628.20102

  5. #5
    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).
    Attached Files Attached Files

  6. #6
    Moderator VBAX Master georgiboy's Avatar
    Joined
    Mar 2008
    Location
    Kent, England
    Posts
    1,244
    Location
    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
    Click here for a guide on how to add code tags
    Click here for a guide on how to mark a thread as solved
    Click here for a guide on how to upload a file with your post

    Excel 365, Version 2405, Build 17628.20102

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

  8. #8
    Moderator VBAX Master georgiboy's Avatar
    Joined
    Mar 2008
    Location
    Kent, England
    Posts
    1,244
    Location
    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
    Click here for a guide on how to add code tags
    Click here for a guide on how to mark a thread as solved
    Click here for a guide on how to upload a file with your post

    Excel 365, Version 2405, Build 17628.20102

  9. #9
    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

  10. #10
    Moderator VBAX Master georgiboy's Avatar
    Joined
    Mar 2008
    Location
    Kent, England
    Posts
    1,244
    Location
    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.
    Click here for a guide on how to add code tags
    Click here for a guide on how to mark a thread as solved
    Click here for a guide on how to upload a file with your post

    Excel 365, Version 2405, Build 17628.20102

  11. #11
    Moderator VBAX Master georgiboy's Avatar
    Joined
    Mar 2008
    Location
    Kent, England
    Posts
    1,244
    Location
    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
    Click here for a guide on how to add code tags
    Click here for a guide on how to mark a thread as solved
    Click here for a guide on how to upload a file with your post

    Excel 365, Version 2405, Build 17628.20102

  12. #12
    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.

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •