VBA loop to skip over certain sheets that do not contain a specific phrase.

[ExcelNUB1234]

Hello,

I am creating a workbook to track repairs and create a report for a specific client. Each trouble ticket (RMA) get its own sheet with details, I am able to copy the necessary information to the place that I need it for my report, however it is doing this for all worksheets except tabs that I have already specified not to, for example my trouble ticket template, my reports pages and any other page with an actual name. My trouble tickets are named by number in the order I receive them from each client I work with.

The problem is, I need to compile the data into a report for one specific client, I need code that will skip over a certain worksheet that does not contain a specific phrase in cell H17, the phrase being "FAR".

Sub CustomerA_Report()
 Dim sh As Worksheet
    Dim wb As Workbook
    Dim DestSh As Worksheet
    Dim i As Integer

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    Set wb = ThisWorkbook
    Set DestSh = wb.Sheets("CustomerA")
  
       i = 3
    For Each sh In ActiveWorkbook.Worksheets
    If sh.Range("E17").Value = "**SPECIFIC PHRASE**" Then
      Worksheets(ActiveSheet.Index + 1).Select
    End If
    If IsError(Application.Match(sh.Name, _
        Array(DestSh.Name, "Index", "Lists", "Current Index", "Changes", "CustomerA"), 0)) Then
        sh.Range("F4").copy

    'RMA#'
        With DestSh.Range("A" & i)
            .PasteSpecial xlPasteValues
            Application.CutCopyMode = False
        End With
   'Client'
         sh.Range("E15").copy
        With DestSh.Range("B" & i)
            .PasteSpecial xlPasteValues
            Application.CutCopyMode = False
        End With
   'Client Department'
        sh.Range("K15").copy
        With DestSh.Range("C" & i)
            .PasteSpecial xlPasteValues
            Application.CutCopyMode = False
        End With
    'FAR'
          sh.Range("H17").copy
        With DestSh.Range("D" & i)
            .PasteSpecial xlPasteValues
            Application.CutCopyMode = False
        End With
    'System SN'
        sh.Range("L4").copy
        With DestSh.Range("E" & i)
            .PasteSpecial xlPasteValues
            Application.CutCopyMode = False
        End With
    'Failed Component'
        sh.Range("F6").copy
        With DestSh.Range("F" & i)
            .PasteSpecial xlPasteValues
            Application.CutCopyMode = False
        End With
     'Failed Component SN'
        sh.Range("L6").copy
        With DestSh.Range("G" & i)
            .PasteSpecial xlPasteValues
            Application.CutCopyMode = False
        End With
     'Date of Report'
        sh.Range("Q4").copy
        With DestSh.Range("H" & i)
            .PasteSpecial xlPasteValues
            Application.CutCopyMode = False
        End With
     'Date of Receipt'
        sh.Range("V23").copy
        With DestSh.Range("I" & i)
            .PasteSpecial xlPasteValues
            Application.CutCopyMode = False
        End With
     'Description of Failure'
        sh.Range("H8").copy
        With DestSh.Range("J" & i)
            .PasteSpecial xlPasteValues
            Application.CutCopyMode = False
        End With
      'Estimated Completion Date'
         sh.Range("N36").copy
        With DestSh.Range("K" & i)
            .PasteSpecial xlPasteValues
            Application.CutCopyMode = False
        End With
      'Diagnostic Start Date'
            sh.Range("G10").copy
        With DestSh.Range("L" & i)
            .PasteSpecial xlPasteValues
            Application.CutCopyMode = False
        End With
      'Diagnostic End Date'
                sh.Range("M10").copy
        With DestSh.Range("M" & i)
            .PasteSpecial xlPasteValues
            Application.CutCopyMode = False
        End With
      'Status'
                sh.Range("V4").copy
        With DestSh.Range("N" & i)
            .PasteSpecial xlPasteValues
            Application.CutCopyMode = False
        End With
      'Date of QA'
                sh.Range("N38").copy
        With DestSh.Range("O" & i)
            .PasteSpecial xlPasteValues
            Application.CutCopyMode = False
        End With
       'Outgoing Tracking #'
                sh.Range("F27").copy
        With DestSh.Range("P" & i)
            .PasteSpecial xlPasteValues
            Application.CutCopyMode = False
        End With
      'Ship Date'
                sh.Range("R27").copy
        With DestSh.Range("Q" & i)
            .PasteSpecial xlPasteValues
            Application.CutCopyMode = False
        End With
       'Warranty'
                sh.Range("Q6").copy
        With DestSh.Range("R" & i)
            .PasteSpecial xlPasteValues
            Application.CutCopyMode = False
        End With
       'Invoice'
                sh.Range("V32").copy
        With DestSh.Range("S" & i)
            .PasteSpecial xlPasteValues
            Application.CutCopyMode = False
        End With
        'Service Level'
                sh.Range("R10").copy
        With DestSh.Range("T" & i)
            .PasteSpecial xlPasteValues
            Application.CutCopyMode = False
        End With
    i = i + 1
  
    End If
    Next
End Sub

Code is ugly, but functional; any help provided will be much appreciated.

 

[Alex Blakenburg]

You should be able to get of your additional if statement and combine it with the other one

If IsError(Application.Match(sh.Name, _
    Array(DestSh.Name, "Index", "Lists", "Current Index", "Changes", "CustomerA"), 0)) _
    And sh.Range("H17").Value Like "*FAR*" Then

 

[Peter_SSs]

I have fixed it for you this time but in future please use the available code tags when posting vba code. It makes your code much easier to read, understand and debug. My signature block below has more details.

 

[DanteAmor]

I optimized your code a bit:

Sub CustomerA_Report()
  Dim sh As Worksheet, DestSh As Worksheet
  Dim i As Long
  
  Set DestSh = ThisWorkbook.Sheets("CustomerA")
  i = 3
  For Each sh In ActiveWorkbook.Worksheets
    If UCase(sh.Range("E17").Value) Like "*FAR*" And _
       IsError(Application.Match(sh.Name, Array(DestSh.Name, "Index", "Lists", "Current Index", "Changes", "CustomerA"), 0)) Then
      DestSh.Range("A" & i).Value = sh.Range("F4").Value    'RMA#'
      DestSh.Range("B" & i).Value = sh.Range("E15").Value   'Client'
      DestSh.Range("C" & i).Value = sh.Range("K15").Value   'Client Department'
      DestSh.Range("D" & i).Value = sh.Range("H17").Value   'FAR'
      DestSh.Range("E" & i).Value = sh.Range("L4").Value    'System SN'
      DestSh.Range("F" & i).Value = sh.Range("F6").Value    'Failed Component'
      DestSh.Range("G" & i).Value = sh.Range("L6").Value    'Failed Component SN'
      DestSh.Range("H" & i).Value = sh.Range("Q4").Value    'Date of Report'
      DestSh.Range("I" & i).Value = sh.Range("V23").Value   'Date of Receipt'
      DestSh.Range("J" & i).Value = sh.Range("H8").Value    'Description of Failure'
      DestSh.Range("K" & i).Value = sh.Range("N36").Value   'Estimated Completion Date'
      DestSh.Range("L" & i).Value = sh.Range("G10").Value   'Diagnostic Start Date'
      DestSh.Range("M" & i).Value = sh.Range("M10").Value   'Diagnostic End Date'
      DestSh.Range("N" & i).Value = sh.Range("V4").Value    'Status'
      DestSh.Range("O" & i).Value = sh.Range("N38").Value   'Date of QA'
      DestSh.Range("P" & i).Value = sh.Range("F27").Value   'Outgoing Tracking #'
      DestSh.Range("Q" & i).Value = sh.Range("R27").Value   'Ship Date'
      DestSh.Range("R" & i).Value = sh.Range("Q6").Value    'Warranty'
      DestSh.Range("S" & i).Value = sh.Range("V32").Value   'Invoice'
      DestSh.Range("T" & i).Value = sh.Range("R10").Value   'Service Level'
      i = i + 1
    End If
  Next
End Sub

 

[Peter_SSs]

Here is another optimization too, though you would lose the comments linking each transfer.

Sub CustomerA_Report_v2()
  Dim sh As Worksheet, DestSh As Worksheet
  Dim i As Long, k As Long
  Dim vCell As Variant
  
  Const CellOrder As String = "F4 E15 K15 H17 L4 F6 L6 Q4 V23 H8 N36 G10 M10 V4 N38 F27 R27 Q6 V32 R10"
  
  Set DestSh = ThisWorkbook.Sheets("CustomerA")
  i = 3
  For Each sh In ActiveWorkbook.Worksheets
    If UCase(sh.Range("E17").Value) Like "*FAR*" And _
       IsError(Application.Match(sh.Name, Array(DestSh.Name, "Index", "Lists", "Current Index", "Changes", "CustomerA"), 0)) Then
      k = 0
      For Each vCell In Split(CellOrder)
        DestSh.Range("A" & i).Offset(, k).Value = sh.Range(vCell).Value
        k = k + 1
      Next vCell
      i = i + 1
    End If
  Next
End Sub

 

[DanteAmor]

Here another little optimization.

Sub CustomerA_Report()
  Dim sh As Worksheet, DestSh As Worksheet, i As Long
  Set DestSh = ThisWorkbook.Sheets("CustomerA")
  i = 3
  For Each sh In ActiveWorkbook.Worksheets
    With sh
    If UCase(.Range("E17").Value) Like "*FAR*" And _
       IsError(Application.Match(.Name, Array(DestSh.Name, "Index", "Lists", "Current Index", "Changes", "CustomerA"), 0)) Then
      DestSh.Range("A" & i & ":T" & i).Value = Array(.[F4], .[E15], .[K15], .[H17], .[L4], .[F6], .[L6], .[Q4], .[V23], .[H8], _
                                                     .[N36], .[G10], .[M10], .[V4], .[N38], .[F27], .[R27], .[Q6], .[V32], .[R10])
      i = i + 1
    End If
    End With
  Next
End Sub