Extra condition in search VBA.

[pete4monc]

Hi all

I already have a vba that searches through multiple sheets in a workbook and finds orders that are over three days old on any single sheet then reports them on a summary sheet.
The problem is I can not get it to report when the order appears multiple times on the same tab?
Please could some one advise if this is possible to add a script into my existing and how I could do this? Hope the above makes sense and many thanks.

Sub Slowmovers()
   Dim ws As Worksheet
   Dim Ary As Variant, Rws As Variant
  
   Sheets("Slowmovers").Select
    Range("A2:B100").Select
    Selection.ClearContents
    Range("A2").Select
  
   For Each ws In Worksheets
      Select Case ws.Name
         Case "Phoenix", "Overview", "Dashboard", "Input", "Tracker", "Holiday List", "Log"      'sheets that should be ignored
         Case Else
            With ws.Range("B5:B" & ws.Range("L" & Rows.count).End(xlUp).Row)
               Rws = Filter(ws.Evaluate(Replace("transpose(if((@>3)*(@<>""""),row(@)-min(row(@))+1,false))", "@", .Offset(, 10).Address)), False, False)
               If UBound(Rws) >= 0 Then Ary = Application.Index(.Value, Application.Transpose(Rws), 1)
            End With
            If UBound(Rws) >= 0 Then
               With Sheets("Slowmovers").Range("A" & Rows.count).End(xlUp).Offset(1)
                  .Resize(UBound(Ary)).Value = ws.Name
                  .Offset(, 1).Resize(UBound(Ary)).Value = Ary
               End With
            End If
      End Select
   Next ws
  
   Range("D1").Value = Format(Now, "mm/dd/yyyy HH:mm:ss")
End Sub

 

[NateSC]

It looks like your macro is only pulling the name of the sheet and then the order number and pasting those in "Slowmovers". I am guessing that Column C and D are using a lookup of some type. You could modify the macro to just pull all this data across instead. There are more elegant ways than what I did below, but I tried to use the same structure in your existing macro so it is consistent. Also, I put "Added" on any line I added. However, I am not sure if this will cause any problems with other equations you may have on the "Slowmovers" sheet.

If the different sheets do not have the columns in the same format as "PCDPlanning", then this may not work.

Sub Slowmovers()
   Dim ws As Worksheet
   Dim Ary As Variant, Rws As Variant
   Dim Ary2 As Variant 'Added
   Dim Ary3 As Variant 'Added
 
   Sheets("Slowmovers").Select
    Range("A2:B100").Select
    Selection.ClearContents
    Range("A2").Select
 
   For Each ws In Worksheets
      Select Case ws.Name
         Case "Phoenix", "Overview", "Dashboard", "Input", "Tracker", "Holiday List", "Log"      'sheets that should be ignored
         Case Else
            With ws.Range("B5:B" & ws.Range("L" & Rows.Count).End(xlUp).Row)
               Rws = Filter(ws.Evaluate(Replace("transpose(if((@>3)*(@<>""""),row(@)-min(row(@))+1,false))", "@", .Offset(, 10).Address)), False, False)
               If UBound(Rws) >= 0 Then Ary = Application.Index(.Value, Application.Transpose(Rws), 1)
            End With
            If UBound(Rws) >= 0 Then 'Added
                With ws.Range("B5:L" & ws.Range("L" & Rows.Count).End(xlUp).Row) 'Added
                    Ary2 = Application.Index(.Value, Application.Transpose(Rws), 2) 'Added
                    Ary3 = Application.Index(.Value, Application.Transpose(Rws), 11) 'Added
                End With 'Added
            End If 'Added
            If UBound(Rws) >= 0 Then
               With Sheets("Slowmovers").Range("A" & Rows.Count).End(xlUp).Offset(1)
                  .Resize(UBound(Ary)).Value = ws.Name
                  .Offset(, 1).Resize(UBound(Ary)).Value = Ary
                  .Offset(, 2).Resize(UBound(Ary2)).Value = Ary2 'Added
                  .Offset(, 3).Resize(UBound(Ary3)).Value = Ary3 'Added
               End With
            End If
      End Select
   Next ws
 
   Range("D1").Value = Format(Now, "mm/dd/yyyy HH:mm:ss")
End Sub

 

[pete4monc]

It looks like your macro is only pulling the name of the sheet and then the order number and pasting those in "Slowmovers". I am guessing that Column C and D are using a lookup of some type. You could modify the macro to just pull all this data across instead. There are more elegant ways than what I did below, but I tried to use the same structure in your existing macro so it is consistent. Also, I put "Added" on any line I added. However, I am not sure if this will cause any problems with other equations you may have on the "Slowmovers" sheet.

If the different sheets do not have the columns in the same format as "PCDPlanning", then this may not work.

Sub Slowmovers()
   Dim ws As Worksheet
   Dim Ary As Variant, Rws As Variant
   Dim Ary2 As Variant 'Added
   Dim Ary3 As Variant 'Added
 
   Sheets("Slowmovers").Select
    Range("A2:B100").Select
    Selection.ClearContents
    Range("A2").Select
 
   For Each ws In Worksheets
      Select Case ws.Name
         Case "Phoenix", "Overview", "Dashboard", "Input", "Tracker", "Holiday List", "Log"      'sheets that should be ignored
         Case Else
            With ws.Range("B5:B" & ws.Range("L" & Rows.Count).End(xlUp).Row)
               Rws = Filter(ws.Evaluate(Replace("transpose(if((@>3)*(@<>""""),row(@)-min(row(@))+1,false))", "@", .Offset(, 10).Address)), False, False)
               If UBound(Rws) >= 0 Then Ary = Application.Index(.Value, Application.Transpose(Rws), 1)
            End With
            If UBound(Rws) >= 0 Then 'Added
                With ws.Range("B5:L" & ws.Range("L" & Rows.Count).End(xlUp).Row) 'Added
                    Ary2 = Application.Index(.Value, Application.Transpose(Rws), 2) 'Added
                    Ary3 = Application.Index(.Value, Application.Transpose(Rws), 11) 'Added
                End With 'Added
            End If 'Added
            If UBound(Rws) >= 0 Then
               With Sheets("Slowmovers").Range("A" & Rows.Count).End(xlUp).Offset(1)
                  .Resize(UBound(Ary)).Value = ws.Name
                  .Offset(, 1).Resize(UBound(Ary)).Value = Ary
                  .Offset(, 2).Resize(UBound(Ary2)).Value = Ary2 'Added
                  .Offset(, 3).Resize(UBound(Ary3)).Value = Ary3 'Added
               End With
            End If
      End Select
   Next ws
 
   Range("D1").Value = Format(Now, "mm/dd/yyyy HH:mm:ss")
End Sub

Hi NateSC

WOW.. that works fantastic. Thanks for your help and quick response!!
Many thanks.