Macro to Find Count or Sum of Sub-Sub Totals and Grand Totals Based on Cell Color Index Number
Sub Grand_Sub_Totals_Count()
X = 0
Z = 0
K = 0
CC = InputBox("Please Enter Column In Which You Want to Find Counts" & vbNewLine _
& "Eg: 1 , 2 , 3 ...", "Please Enter Counting Column Number")
If CC = vbNullString Then Exit Sub
CC = Val(CC) 'Converting String Input to a Number Value
For A = 1 To 2500 'Records/Rows Range
"Put '1' in Each Cell of the Counting Column then Run Macro"
"Color-I Criteria :"
If (ActiveSheet.Cells(A, CC) = 1) And (ActiveSheet.Cells(A, CC).Interior.ColorIndex = -4142) Then
X = X + 1 ' Adding Sub-Sub Totals
"Color-II Criteria :"
ElseIf (ActiveSheet.Cells(A, CC).Interior.ColorIndex = 35) Then
ActiveSheet.Cells(A, CC).Value = X
Z = Z + X ' Adding Sub Totals
X = 0
End If
"Color-III Criteria :"
If (ActiveSheet.Cells(A, CC).Interior.ColorIndex = 43) Then
ActiveSheet.Cells(A, CC).Value = Z
K = K + Z ' Adding Grand Totals
Z = 0
End If
If (ActiveSheet.Cells(A, CC).Interior.ColorIndex = 14) Then
ActiveSheet.Cells(A, CC).Value = K
K = 0
End If
Next A
End Sub
Sub Grand_Sub_Totals_Count()
X = 0
Z = 0
K = 0
CC = InputBox("Please Enter Column In Which You Want to Find Counts" & vbNewLine _
& "Eg: 1 , 2 , 3 ...", "Please Enter Counting Column Number")
If CC = vbNullString Then Exit Sub
CC = Val(CC) 'Converting String Input to a Number Value
For A = 1 To 2500 'Records/Rows Range
"Put '1' in Each Cell of the Counting Column then Run Macro"
"Color-I Criteria :"
If (ActiveSheet.Cells(A, CC) = 1) And (ActiveSheet.Cells(A, CC).Interior.ColorIndex = -4142) Then
X = X + 1 ' Adding Sub-Sub Totals
"Color-II Criteria :"
ElseIf (ActiveSheet.Cells(A, CC).Interior.ColorIndex = 35) Then
ActiveSheet.Cells(A, CC).Value = X
Z = Z + X ' Adding Sub Totals
X = 0
End If
"Color-III Criteria :"
If (ActiveSheet.Cells(A, CC).Interior.ColorIndex = 43) Then
ActiveSheet.Cells(A, CC).Value = Z
K = K + Z ' Adding Grand Totals
Z = 0
End If
If (ActiveSheet.Cells(A, CC).Interior.ColorIndex = 14) Then
ActiveSheet.Cells(A, CC).Value = K
K = 0
End If
Next A
End Sub
No comments:
Post a Comment
Hi User, Thank You for visiting My Blog. Please post your genuine Feedback or comments only related to this Blog Posts. Please do not post any Spam comments or Advertising kind of comments which will be Ignored.