VBA macro only processing one if statement-CodePudding

EDIT:

Here's the updated code that Tim provided below.

I made a few changes to help with the readability. Cells I1:I15 have either a "Y" or "N" in them. The macro works if there's a Y in I1 but doesn't work with any others. I'm wondering if anyone can confirm if this is how the macro is reading this code....

If cell I1 is "Y", then open spreadsheets linked in A5:A8 (these are file paths), then copy data from the A5 spreadsheet (from processed summary tab) from M5:M63 and paste into spreadsheets A6,A7,A8 at L5:L63.

If cell I3 is "Y", then open spreadsheets linked in A15:A18, then pull data from the A15 spreadsheet (from processed summary tab) from M5:M63 and paste into spreadsheets A16,A17,A18 at L5:L63.

And this will continue for any "Y" in I1:I15.

Thanks

Sub Foo6()

    Dim wbSource As Workbook, wsConfig As Worksheet
    Dim vals As Variant, c As Range
    
    Set wsConfig = ThisWorkbook.Worksheets("Sheet1")
    'process each block of names in turn...
    DoCopies wsConfig.Range("A5:A8")
    DoCopies wsConfig.Range("A9:A14")
    DoCopies wsConfig.Range("A15:A18")
    DoCopies wsConfig.Range("A19:A24")
    DoCopies wsConfig.Range("A25:A33")
    DoCopies wsConfig.Range("A34:A37")
    DoCopies wsConfig.Range("A38:A43")
    DoCopies wsConfig.Range("A44:A47")
    DoCopies wsConfig.Range("A48:A53")
    DoCopies wsConfig.Range("A54:A62")
    DoCopies wsConfig.Range("A63:A66")
    DoCopies wsConfig.Range("A67:A72")
    DoCopies wsConfig.Range("A73:A76")
    DoCopies wsConfig.Range("A77:A82")
    DoCopies wsConfig.Range("A83:A91")
    
End Sub

'process workbook copying: first cell in `rng` is the source workbook,
'  the rest are destination workbooks
Sub DoCopies(rng As Range)
    Const SHT_NAME As String = "Processed Summary"
    Dim wbSource As Workbook, i As Long, rngSrc As Range
    
    If rng.Cells(1).EntireRow.Columns("I").Value = "Y" Then 'process this block?
        Set wbSource = Workbooks.Open(rng.Cells(1).Value, UpdateLinks:=0)
        Set rngSrc = wbSource.Worksheets(SHT_NAME).Range("M5:M63")
        For i = 2 To rng.Cells.Count
            With Workbooks.Open(rng.Cells(i).Value, UpdateLinks:=0)
                .Worksheets(SHT_NAME).Range("L5:L63").Value = rngSrc.Value
                .Save
                .Close
            End With
        Next i
        wbSource.Close False 'no save
    End If
End Sub

CodePudding user response：

Your code could be condensed a lot using loops, and further if your actions are as consistent as they seem to be (always the same logic and ranges to be copied).

Also helps to be very specific about what sheets you're working with - your code should never have any call to Range() or Cells() which isn't qualified with a specific sheet reference.

EDIT: re-worked the "flag" range and condensed to a single sub.

Eg:

Sub Foo5()
    Const SHT_NAME As String = "Processed Summary"
    Dim arr, rngFlag As Range, el
    Dim wbSource As Workbook, wsConfig As Worksheet
    Dim c As Range, rng As Range
    Dim i As Long, rngSrc As Range
    
    Set wsConfig = ThisWorkbook.Worksheets("Sheet1")
    'all source range addresses in an array
    arr = Array("A5:A8", "A9:A14", "A15:A18", "A19:A24", "A25:A33", "A34:A37", _
                "A38:A43", "A44:A47", "A48:A53", "A54:A62", "A63:A66", "A67:A72", _
                "A73:A76", "A77:A82", "A83:A91")
    
    Set rngFlag = wsConfig.Range("I1")     'first "flag" cell
    
    For Each el In arr                     'loop over the array of range addresses
        If rngFlag.Value = "Y" Then        'process this block?
            Set rng = wsConfig.Range(el)   'get the range of workbook names/paths
            Set wbSource = Workbooks.Open(rng.Cells(1).Value, UpdateLinks:=0)
            Set rngSrc = wbSource.Worksheets(SHT_NAME).Range("M5:M63")
            For i = 2 To rng.Cells.Count
                With Workbooks.Open(rng.Cells(i).Value, UpdateLinks:=0)
                    .Worksheets(SHT_NAME).Range("L5:L63").Value = rngSrc.Value
                    .Close SaveChanges:=True
                End With
            Next i
            wbSource.Close SaveChanges:=False 
        End If
        Set rngFlag = rngFlag.Offset(1) 'next cell down
    Next el
End Sub