Consulting

Results 1 to 10 of 10

Thread: Multiple Date matches

  1. #1

    Multiple Date matches

    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?
    Attached Files Attached Files
    Last edited by Wheelie686; 06-06-2024 at 08:14 PM.

  2. #2
    Moderator VBAX Wizard Aussiebear's Avatar
    Joined
    Dec 2005
    Location
    Queensland
    Posts
    5,183
    Location
    Loop through each cell in Range(A3:A42) and carry out your required operation.
    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
    Moderator VBAX Master georgiboy's Avatar
    Joined
    Mar 2008
    Location
    Kent, England
    Posts
    1,244
    Location
    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
    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

  4. #4
    Moderator VBAX Master georgiboy's Avatar
    Joined
    Mar 2008
    Location
    Kent, England
    Posts
    1,244
    Location
    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

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

  6. #6
    Moderator VBAX Master georgiboy's Avatar
    Joined
    Mar 2008
    Location
    Kent, England
    Posts
    1,244
    Location
    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

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

  8. #8
    Moderator VBAX Master georgiboy's Avatar
    Joined
    Mar 2008
    Location
    Kent, England
    Posts
    1,244
    Location
    Quote Originally Posted by Wheelie686 View Post
    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'?

  9. #9
    ln Staff Plan

  10. #10
    Moderator VBAX Master georgiboy's Avatar
    Joined
    Mar 2008
    Location
    Kent, England
    Posts
    1,244
    Location
    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
    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

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
  •