C
charles.w.price
I have a macro below that runs perfectly, but I would like it to run
on all worksheets and not just the active worksheet. The format on
each worksheet is identical, only the data differs. Could someone
help me add the extra code needed for the code to run on all
worksheets at the same time?
Thanks.
Sub SubTotal_All_Worksheets()
Dim intI As Integer
Dim intJ As Integer
Dim intK As Integer
Dim strA As String
Dim strB As String
Dim strFormula As String
Dim CDelta As String
Dim RStart As String
Dim CSum As String
CSum = InputBox("For which column do you wish to create sub-
totals?", "Sub-Total")
CDelta = InputBox("Create sums for each change in what column?",
"Column")
RStart = InputBox("What is the first row of data in that column?",
"Row")
intJ = 0
intK = 0
Range(CDelta & RStart).Select
For intI = 1 To 20000
strA = Range(CDelta & intI + RStart - 1 + intJ)
strB = Range(CDelta & intI + RStart + intJ)
If strA = strB Then
intK = intK + 1
Else:
Range(CDelta & intI + 2 + intJ).Select
Selection.EntireRow.Insert
strFormula = "=sum(" & CSum & (intI + RStart - 1 + intJ) & ":"
& CSum & (intI + RStart - 1 + intJ - intK) & ")"
Range(CSum & intI + RStart + intJ) = strFormula
Range(CSum & intI + RStart + intJ).Select
Selection.Font.Bold = True
intJ = intJ + 1
intK = 0
End If
Next intI
End Sub
on all worksheets and not just the active worksheet. The format on
each worksheet is identical, only the data differs. Could someone
help me add the extra code needed for the code to run on all
worksheets at the same time?
Thanks.
Sub SubTotal_All_Worksheets()
Dim intI As Integer
Dim intJ As Integer
Dim intK As Integer
Dim strA As String
Dim strB As String
Dim strFormula As String
Dim CDelta As String
Dim RStart As String
Dim CSum As String
CSum = InputBox("For which column do you wish to create sub-
totals?", "Sub-Total")
CDelta = InputBox("Create sums for each change in what column?",
"Column")
RStart = InputBox("What is the first row of data in that column?",
"Row")
intJ = 0
intK = 0
Range(CDelta & RStart).Select
For intI = 1 To 20000
strA = Range(CDelta & intI + RStart - 1 + intJ)
strB = Range(CDelta & intI + RStart + intJ)
If strA = strB Then
intK = intK + 1
Else:
Range(CDelta & intI + 2 + intJ).Select
Selection.EntireRow.Insert
strFormula = "=sum(" & CSum & (intI + RStart - 1 + intJ) & ":"
& CSum & (intI + RStart - 1 + intJ - intK) & ")"
Range(CSum & intI + RStart + intJ) = strFormula
Range(CSum & intI + RStart + intJ).Select
Selection.Font.Bold = True
intJ = intJ + 1
intK = 0
End If
Next intI
End Sub