CODEWITHSUNDEEP
vbaexcel
FaizanRoshan
FaizanRoshan

Reputation: 17

Vba loop for many sheets

I have vba code that adds calculations for 4 sheets. I want a loop that will calculate hundreds of sheet without adding sheetname again & again in code. 

Private Sub CommandButton2_Click()

   Dim TabNames As Variant, Ordinals As Variant

   TabNames = Array("4-16 - 4-22", "4-23 - 4-29", "4-30 - 5-6")
   Ordinals = Array("1st", "2nd", "3rd")

    For i = 0 To UBound(TabNames, 1)
       Range("A5").Offset(i).Value = TabNames(i)
       Range("B5").Offset(i).Value = Ordinals(i)
       Range("I5").Offset(i).Formula = "=AVERAGE('" & "adt" & TabNames(i) & "'!$P:$P)"
       Range("J5").Offset(i).Formula = "=COUNTIFS('" & "adt" & TabNames(i) & "'!$P:$P,"">=""&1)"
       Range("C5").Offset(i).Formula = "=AVERAGEIFS('" & "adt" & TabNames(i) & "'!$P:$P, '" & "adt" & TabNames(i) & "'!$P:$P, "">301"",'" & "adt" & TabNames(i) & "'!$P:$P, ""<480"")"
       Range("D5").Offset(i).Formula = "=COUNTIFS('" & "adt" & TabNames(i) & "'!$P:$P,"">""&301,'" & "adt" & TabNames(i) & "'!$P:$P,""<""&480)"
       Range("F5").Offset(i).Formula = "=AVERAGEIFS('" & "adt" & TabNames(i) & "'!$P:$P, '" & "adt" & TabNames(i) & "'!$P:$P, "">=1"",'" & "adt" & TabNames(i) & "'!$P:$P, ""<300"")"
       Range("G5").Offset(i).Formula = "=COUNTIFS('" & "adt" & TabNames(i) & "'!$P:$P,"">=""&1,'" & "adt" & TabNames(i) & "'!$P:$P,""<""&300)"
    Next
    Range("E5:E7,H5:H7,K5:K7").FormulaR1C1 = "=(R2C3-R[0]C[-2])*(R1C4*R[0]C[-1])"
End Sub

Thank you for your help.

Upvotes: 1

Views: 222

Answers (1)

Don Jewett
Don Jewett

Reputation: 1977

First, create a routine that does what you want for one Sheet using parameters:

Private Sub AddTableFormulas(ByVal sName As String, ByVal nOffset As Long)
    With Sheets("NameOfTotalsSheet")
        .Range("A5").Offset(nOffset).Value = sName
        .Range("B5").Offset(nOffset).Value = getOrdinal(nOffset + 1)
        .Range("I5").Offset(nOffset).Formula = "=AVERAGE('" & "adt" & sName & "'!$P:$P)"

        'etc

    End With
End Sub

Private Function getOrdinal(ByVal nNumber As Long) As String
    Dim sNumber As String 

    sNumber = nNumber
    Select Case Right(sNumber,1)
        Case "1"
            getOrdinal = nNumber & "st"
        Case "2"
            getOrdinal = nNumber & "nd"
        Case "3"
            getOrdinal = nNumber & "rd"
        Case Else
            getOrdinal = nNumber & "th"
    End Select

End Function

Second, write a routine that does it for all Sheets that match your criteria:

Public Sub AddAllFormulas()
    Dim oSheet As Excel.Worksheet
    Dim sName As String
    Dim nOffset As Long

    For Each oSheet In Worksheets
        If Left(oSheet.Name, 3) = "adt" Then
            sName = Right(oSheet.Name, Len(oSheet.Name) - 3)
            AddTableFormulas sName, nOffset
            nOffset = nOffset + 1
        End If
    Next 'oSheet

    'add final calculations here. use offset to determine location

End Sub

Finally, call this routine from your button:

Private Sub CommandButton2_Click()
    AddAllFormulas
End Sub

Upvotes: 3

Related Questions