VBA: Loop thru array of cells

[FryGirl]

I need to account for four different array of cells which I do thru a user entered value in an InputBox.

I'm getting something out of place in the below code. The array will start in row 2 and column C filling in to the right before going to the next workbook.

The part I can't get starts at:

If myInputBox = 1 Then varCellRefs

And then how to loop thru the array for the LBound / UBound

Option Explicit

Sub LoopAllExcelFilesInFolder()

    Dim wb          As Workbook
    Dim wbName      As Workbook: Set wbName = ThisWorkbook
    Dim wsSrc       As Worksheet: Set wsSrc = wbName.Sheets(1)
    Dim myPath      As String
    Dim myFile      As String
    Dim strFile     As String
    Dim Path        As String
    Dim myMaster    As String
    Dim r           As Long: r = 1
    Dim LastCol     As Long
    Dim Lastrow     As Long
    Dim lngIndex    As Long
    Dim myInputBox  As String
    Dim varCellRefs
    
    myInputBox = Application.InputBox(Prompt:="Which Progress check is this for?" _
        & vbCrLf & vbCrLf & "1 = Progress Check - Workload Data " _
        & vbCrLf & vbCrLf & "2 = Progress Check - Data Analysis " _
        & vbCrLf & vbCrLf & "3 = Progress Check - Statistics " _
        & vbCrLf & vbCrLf & "4 = Progress Check - Minimum Manning ", _
        Title:="Paste Worksheet/s", Default:=1, Type:=1)

    If myInputBox = False Then Exit Sub

    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual

    myPath = ActiveWorkbook.Path & Application.PathSeparator
    strFile = "*.xlsx"
    myFile = Dir(myPath & strFile)
    
    Do While myFile <> ""
        If Not myFile = "_Template.xlsx" Then
            Set wb = Workbooks.Open(Filename:=myPath & myFile)
            DoEvents
                r = r + 1
                With wb
                    .Sheets(1).Unprotect "password"
                    .Sheets(1).Range("E2").Font.ColorIndex = 1
                    .Sheets(1).Range("F2").Font.ColorIndex = 1
                    .Sheets(1).Range("D2").Value = wsSrc.Cells(r, 1).Value
                    .Unprotect "password"
                    .Sheets(1).Name = wsSrc.Cells(r, 1).Value
                    .Sheets(1).Copy After:=wsSrc
                    .Sheets(1).Protect "password"
                    .Protect "password"
                    
                    If myInputBox = 1 Then LastCol = 15
                    If myInputBox = 2 Then LastCol = 10
                    If myInputBox = 3 Then LastCol = 13
                    If myInputBox = 4 Then LastCol = 10
                    
                    wsSrc.Cells(r, 2) = myFile
                    
                    If myInputBox = 1 Then varCellRefs = Array("B6", "B16", "B23", "B30", "B40", "B46", "B54", "B63", "B70", "B78", "B85", "B93", "B105", "B119", "B131")
                    If myInputBox = 2 Then varCellRefs = Array("B6", "B15", "B23", "B33", "B38", "B48", "B56", "B62", "B70", "B79")
                    If myInputBox = 3 Then varCellRefs = Array("B9", "B17", "B22", "B31", "B39", "B49", "B54", "B63", "B71", "B78", "B86", "B95", "B102")
                    If myInputBox = 4 Then varCellRefs = Array("B8", "B14", "B25", "B33", "B38", "B47", "B57", "B64", "B70", "B82")
                    
                    For lngIndex = LBound(varCellRefs) To UBound(varCellRefs)
                        wsSrc.Cells(r + 1, lngIndex + 3) = wb.Sheets(1).Range(lngIndex)
                    Next lngIndex

                    wsSrc.Cells(r, 13).Formula = "=SUM(" & wsSrc.Range(wsSrc.Cells(r, 3), wsSrc.Cells(r, LastCol)).Address(False, False) & ")"
                    wsSrc.Cells(r, 14).FormulaR1C1 = "=RC[-1]/" & LastCol & ""
                    
                    .Close SaveChanges:=True
                End With
            DoEvents
        End If
        myFile = Dir
    Loop

    With wsSrc
        .Select
        Lastrow = .Cells(Rows.Count, "A").End(xlUp).Row
        
        With .Range(.Cells(1, 2), .Cells(1, LastCol + 2))
            If myInputBox = 1 Then .Value = Array("Name", "Q1", "Q2", "Q3", "Q4", "Q5", "Q6", "Q7", "Q8", "Q9", "Q10", "Q11", "Q12", "Q13", "Q14", "Q15", "Total", "Percentage")
            If myInputBox = 2 Then .Value = Array("Name", "Q1", "Q2", "Q3", "Q4", "Q5", "Q6", "Q7", "Q8", "Q9", "Q10", "Total", "Percentage")
            If myInputBox = 3 Then .Value = Array("Name", "Q1", "Q2", "Q3", "Q4", "Q5", "Q6", "Q7", "Q8", "Q9", "Q10", "Q11", "Q12", "Q13", "Total", "Percentage")
            If myInputBox = 4 Then .Value = Array("Name", "Q1", "Q2", "Q3", "Q4", "Q5", "Q6", "Q7", "Q8", "Q9", "Q10", "Total", "Percentage")
        End With
        
        .Range(.Cells(1, 1), .Cells(1, LastCol + 2)).Font.Bold = True
        .Range(.Cells(1, 1), .Cells(1, LastCol + 2)).Interior.ColorIndex = 16
        .UsedRange.Borders.LineStyle = xlContinuous
        .Columns(LastCol + 2).NumberFormat = "0.00%"
        .Columns(2).HorizontalAlignment = xlLeft
        .Cells.Columns.AutoFit
        .Range(.Cells(1, 3), .Cells(1, LastCol)).ColumnWidth = 5
        .Range("C1").Resize(Lastrow, LastCol + 2).HorizontalAlignment = xlCenter
        .Range("C1").Resize(Lastrow, LastCol + 2).VerticalAlignment = xlCenter
    End With
    
    ActiveWindow.DisplayGridlines = False
    wsSrc.Range("A2").Select
    ActiveWindow.FreezePanes = True

ResetSettings:
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

End Sub

 

[offthelip]

I am not entirely sure what you are trying to do, but I did notice that you load up varcellsrefs, but never use it, you also have a range reference which isn't going to work. putting the two together I think this might be the modification you need:
change this line;

wsSrc.Cells(r + 1, lngIndex + 3) = wb.Sheets(1).Range(lngIndex)

to

wsSrc.Cells(r + 1, lngIndex + 3) = wb.Sheets(1).Range(varcellsrefs(lngIndex))

 

[FryGirl]

That did it. Thank you.