austenr
10-18-2006, 10:22 AM
What I am attempting to do below is to read row by row and depending on what the value in column H is, add to some totals. At the end I want to place the totals in the sheet called NE ECR. With the example data in the spreadsheet attached, all of the totals would go in the row 10 - 50K in the NEECR sheet. The way it is now seems very redundent (and will not run) the way it is now. Is there a way to shorten it? I have 2 other regions that basically work the same way. Thanks in advance.
Sub CheckECR()
Dim TenTo50CustCount As Long
Dim i As Long, FinalRow As Long
FinalRow = Cells(65536, 1).End(xlUp).Row
For i = 2 To FinalRow
If Cells(i, 8).Value = "0.0096" Then
TotalNewEnglandECR00096
End If
If Cells(i, 8).Value = "0.0105" Then
TotalNewEnglandECR00105
End If
If Cells(i, 8).Value = "0.011" Then
TotalNewEnglandECR0011
End If
If Cells(i, 8).Value = "0.013" Then
TotalNewEnglandECR0013
End If
Next
Sheets("NE_ECR").Select
Cells(5, 6).Value = TenTo50CustCount
End Sub
Sub TotalNewEnglandECR00096()
Dim i As Long
Dim TenTo50CustCount As Long
Dim FiftyTo100CustCount As Long
Dim OneHumdredAndOverCustomerCount As Long
Dim Tento50ECRAmountTotal As Long
Dim Fiftyto100ECRAmountTotal As Long
Dim OneHunderdandOverECRAmountTotal As Long
Dim Tento50AvailBalTotal As Long
Dim Fiftyto100AvailBalTotal As Long
Dim OneHundredandOverAvailBalTotal As Long
Dim Tento50TotalChargeTotal As Long
Dim Fiftyto100TotalChargeTotal As Long
Dim OneHundredandOvertotalChargeTotal As Long
Dim Tento50ServiceChargeTotal As Long
Dim Fiftyto100ServiceChargeTotal As Long
Dim OneHunderdandOverServiceChargeTotal As Long
Dim FinalRow As Long
'Process Avail Bal 10000 to 50000
If Cells(i, 10).Value < 50000 Then
Tento50ServiceChargeTotal = Tento50ServiceChargeTotal + Cells(i, 7).Value
Tento50ECRAmountTotal = Tento50ECRAmountTotal + Cells(i, 9).Value
Tento50TotalChargeTotal = Tento50TotalChargeTotal + Cells(i, 11).Value
Tento50AvailBalTotal = Tento50AvailBalTotal + Cells(i, 10).Value
TenTo50CustCount = TenTo50CustCount + 1
End If
'Process Avail Bal 50000 to 100000
If Cells(i, 10).Value > 50000 < 100000 Then
Fiftyto100ServiceChargeTotal = Fiftyto100ServiceChargeTotal + Cells(i, 7).Value
Fiftyto100ECRAmountTotal = Fiftyto100ECRAmountTotal + Cells(i, 9).Value
Fiftyto100TotalChargeTotal = Fiftyto100TotalChargeTotal + Cells(i, 11).Value
Fiftyto100AvailBalTotal = Fiftyto100AvailBalTotal + Cells(i, 10).Value
FiftyTo100CustCount = FiftyTo100CustCount + 1
End If
' Process Avail Bal 100000 and over
If Cells(i, 10).Value > 100000 Then
OneHunderdandOverServiceChargeTotal = OneHunderdandOverServiceChargeTotal + Cells(i, 7).Value
OneHunderdandOverECRAmountTotal = OneHunderdandOverECRAmountTotal + Cells(i, 9).Value
OneHundredandOvertotalChargeTotal = OneHundredandOvertotalChargeTotal + Cells(i, 11).Value
OneHundredandOverAvailBalTotal = OneHundredandOverAvailBalTotal + Cells(i, 10).Value
OneHumdredAndOverCustomerCount = OneHumdredAndOverCustomerCount + 1
End If
End Sub
Sub TotalNewEnglandECR00105()
Dim i As Long
Dim TenTo50CustCount As Long
Dim FiftyTo100CustCount As Long
Dim OneHumdredAndOverCustomerCount As Long
Dim Tento50ECRAmountTotal As Long
Dim Fiftyto100ECRAmountTotal As Long
Dim OneHunderdandOverECRAmountTotal As Long
Dim Tento50AvailBalTotal As Long
Dim Fiftyto100AvailBalTotal As Long
Dim OneHundredandOverAvailBalTotal As Long
Dim Tento50TotalChargeTotal As Long
Dim Fiftyto100TotalChargeTotal As Long
Dim OneHundredandOvertotalChargeTotal As Long
Dim Tento50ServiceChargeTotal As Long
Dim Fiftyto100ServiceChargeTotal As Long
Dim OneHunderdandOverServiceChargeTotal As Long
Dim FinalRow As Long
'Process Avail Bal 10000 to 50000
If Cells(i, 10).Value > 10000 And Cells(i, 10).Value < 50000 Then
Tento50ServiceChargeTotal = Tento50ServiceChargeTotal + Cells(i, 7).Value
Tento50ECRAmountTotal = Tento50ECRAmountTotal + Cells(i, 9).Value
Tento50TotalChargeTotal = Tento50TotalChargeTotal + Cells(i, 11).Value
Tento50AvailBalTotal = Tento50AvailBalTotal + Cells(i, 10).Value
TenTo50CustCount = TenTo50CustCount + 1
End If
'Process Avail Bal 50000 to 100000
If Cells(i, 10).Value > 50000 And Cells(i, 10).Value < 100000 Then
Fiftyto100ServiceChargeTotal = Fiftyto100ServiceChargeTotal + Cells(i, 7).Value
Fiftyto100ECRAmountTotal = Fiftyto100ECRAmountTotal + Cells(i, 9).Value
Fiftyto100TotalChargeTotal = Fiftyto100TotalChargeTotal + Cells(i, 11).Value
Fiftyto100AvailBalTotal = Fiftyto100AvailBalTotal + Cells(i, 10).Value
FiftyTo100CustCount = FiftyTo100CustCount + 1
End If
' Process Avail Bal 100000 and over
If Cells(i, 10).Value > 100000 Then
OneHunderdandOverServiceChargeTotal = OneHunderdandOverServiceChargeTotal + Cells(i, 7).Value
OneHunderdandOverECRAmountTotal = OneHunderdandOverECRAmountTotal + Cells(i, 9).Value
OneHundredandOvertotalChargeTotal = OneHundredandOvertotalChargeTotal + Cells(i, 11).Value
OneHundredandOverAvailBalTotal = OneHundredandOverAvailBalTotal + Cells(i, 10).Value
OneHumdredAndOverCustomerCount = OneHumdredAndOverCustomerCount + 1
End If
End Sub
Sub TotalNewEnglandECR0011()
Dim i As Long
Dim TenTo50CustCount As Long
Dim FiftyTo100CustCount As Long
Dim OneHumdredAndOverCustomerCount As Long
Dim Tento50ECRAmountTotal As Long
Dim Fiftyto100ECRAmountTotal As Long
Dim OneHunderdandOverECRAmountTotal As Long
Dim Tento50AvailBalTotal As Long
Dim Fiftyto100AvailBalTotal As Long
Dim OneHundredandOverAvailBalTotal As Long
Dim Tento50TotalChargeTotal As Long
Dim Fiftyto100TotalChargeTotal As Long
Dim OneHundredandOvertotalChargeTotal As Long
Dim Tento50ServiceChargeTotal As Long
Dim Fiftyto100ServiceChargeTotal As Long
Dim OneHunderdandOverServiceChargeTotal As Long
Dim FinalRow As Long
'Process Avail Bal 10000 to 50000
If Cells(i, 10).Value > 10000 And Cells(i, 10).Value < 50000 Then
Tento50ServiceChargeTotal = Tento50ServiceChargeTotal + Cells(i, 7).Value
Tento50ECRAmountTotal = Tento50ECRAmountTotal + Cells(i, 9).Value
Tento50TotalChargeTotal = Tento50TotalChargeTotal + Cells(i, 11).Value
Tento50AvailBalTotal = Tento50AvailBalTotal + Cells(i, 10).Value
TenTo50CustCount = TenTo50CustCount + 1
End If
'Process Avail Bal 50000 to 100000
If Cells(i, 10).Value > 50000 And Cells(i, 10).Value < 100000 Then
Fiftyto100ServiceChargeTotal = Fiftyto100ServiceChargeTotal + Cells(i, 7).Value
Fiftyto100ECRAmountTotal = Fiftyto100ECRAmountTotal + Cells(i, 9).Value
Fiftyto100TotalChargeTotal = Fiftyto100TotalChargeTotal + Cells(i, 11).Value
Fiftyto100AvailBalTotal = Fiftyto100AvailBalTotal + Cells(i, 10).Value
FiftyTo100CustCount = FiftyTo100CustCount + 1
End If
' Process Avail Bal 100000 and over
If Cells(i, 10).Value > 100000 Then
OneHunderdandOverServiceChargeTotal = OneHunderdandOverServiceChargeTotal + Cells(i, 7).Value
OneHunderdandOverECRAmountTotal = OneHunderdandOverECRAmountTotal + Cells(i, 9).Value
OneHundredandOvertotalChargeTotal = OneHundredandOvertotalChargeTotal + Cells(i, 11).Value
OneHundredandOverAvailBalTotal = OneHundredandOverAvailBalTotal + Cells(i, 10).Value
OneHumdredAndOverCustomerCount = OneHumdredAndOverCustomerCount + 1
End If
End Sub
Sub TotalNewEnglandECR0013()
Dim i As Long
Dim TenTo50CustCount As Long
Dim FiftyTo100CustCount As Long
Dim OneHumdredAndOverCustomerCount As Long
Dim Tento50ECRAmountTotal As Long
Dim Fiftyto100ECRAmountTotal As Long
Dim OneHunderdandOverECRAmountTotal As Long
Dim Tento50AvailBalTotal As Long
Dim Fiftyto100AvailBalTotal As Long
Dim OneHundredandOverAvailBalTotal As Long
Dim Tento50TotalChargeTotal As Long
Dim Fiftyto100TotalChargeTotal As Long
Dim OneHundredandOvertotalChargeTotal As Long
Dim Tento50ServiceChargeTotal As Long
Dim Fiftyto100ServiceChargeTotal As Long
Dim OneHunderdandOverServiceChargeTotal As Long
Dim FinalRow As Long
'Process Avail Bal 10000 to 50000
If Cells(i, 10).Value > 10000 And Cells(i, 10).Value < 50000 Then
Tento50ServiceChargeTotal = Tento50ServiceChargeTotal + Cells(i, 7).Value
Tento50ECRAmountTotal = Tento50ECRAmountTotal + Cells(i, 9).Value
Tento50TotalChargeTotal = Tento50TotalChargeTotal + Cells(i, 11).Value
Tento50AvailBalTotal = Tento50AvailBalTotal + Cells(i, 10).Value
TenTo50CustCount = TenTo50CustCount + 1
End If
'Process Avail Bal 50000 to 100000
If Cells(i, 10).Value > 50000 And Cells(i, 10).Value < 100000 Then
Fiftyto100ServiceChargeTotal = Fiftyto100ServiceChargeTotal + Cells(i, 7).Value
Fiftyto100ECRAmountTotal = Fiftyto100ECRAmountTotal + Cells(i, 9).Value
Fiftyto100TotalChargeTotal = Fiftyto100TotalChargeTotal + Cells(i, 11).Value
Fiftyto100AvailBalTotal = Fiftyto100AvailBalTotal + Cells(i, 10).Value
FiftyTo100CustCount = FiftyTo100CustCount + 1
End If
' Process Avail Bal 100000 and over
If Cells(i, 10).Value > 100000 Then
OneHunderdandOverServiceChargeTotal = OneHunderdandOverServiceChargeTotal + Cells(i, 7).Value
OneHunderdandOverECRAmountTotal = OneHunderdandOverECRAmountTotal + Cells(i, 9).Value
OneHundredandOvertotalChargeTotal = OneHundredandOvertotalChargeTotal + Cells(i, 11).Value
OneHundredandOverAvailBalTotal = OneHundredandOverAvailBalTotal + Cells(i, 10).Value
OneHumdredAndOverCustomerCount = OneHumdredAndOverCustomerCount + 1
End If
End Sub
Sub CheckECR()
Dim TenTo50CustCount As Long
Dim i As Long, FinalRow As Long
FinalRow = Cells(65536, 1).End(xlUp).Row
For i = 2 To FinalRow
If Cells(i, 8).Value = "0.0096" Then
TotalNewEnglandECR00096
End If
If Cells(i, 8).Value = "0.0105" Then
TotalNewEnglandECR00105
End If
If Cells(i, 8).Value = "0.011" Then
TotalNewEnglandECR0011
End If
If Cells(i, 8).Value = "0.013" Then
TotalNewEnglandECR0013
End If
Next
Sheets("NE_ECR").Select
Cells(5, 6).Value = TenTo50CustCount
End Sub
Sub TotalNewEnglandECR00096()
Dim i As Long
Dim TenTo50CustCount As Long
Dim FiftyTo100CustCount As Long
Dim OneHumdredAndOverCustomerCount As Long
Dim Tento50ECRAmountTotal As Long
Dim Fiftyto100ECRAmountTotal As Long
Dim OneHunderdandOverECRAmountTotal As Long
Dim Tento50AvailBalTotal As Long
Dim Fiftyto100AvailBalTotal As Long
Dim OneHundredandOverAvailBalTotal As Long
Dim Tento50TotalChargeTotal As Long
Dim Fiftyto100TotalChargeTotal As Long
Dim OneHundredandOvertotalChargeTotal As Long
Dim Tento50ServiceChargeTotal As Long
Dim Fiftyto100ServiceChargeTotal As Long
Dim OneHunderdandOverServiceChargeTotal As Long
Dim FinalRow As Long
'Process Avail Bal 10000 to 50000
If Cells(i, 10).Value < 50000 Then
Tento50ServiceChargeTotal = Tento50ServiceChargeTotal + Cells(i, 7).Value
Tento50ECRAmountTotal = Tento50ECRAmountTotal + Cells(i, 9).Value
Tento50TotalChargeTotal = Tento50TotalChargeTotal + Cells(i, 11).Value
Tento50AvailBalTotal = Tento50AvailBalTotal + Cells(i, 10).Value
TenTo50CustCount = TenTo50CustCount + 1
End If
'Process Avail Bal 50000 to 100000
If Cells(i, 10).Value > 50000 < 100000 Then
Fiftyto100ServiceChargeTotal = Fiftyto100ServiceChargeTotal + Cells(i, 7).Value
Fiftyto100ECRAmountTotal = Fiftyto100ECRAmountTotal + Cells(i, 9).Value
Fiftyto100TotalChargeTotal = Fiftyto100TotalChargeTotal + Cells(i, 11).Value
Fiftyto100AvailBalTotal = Fiftyto100AvailBalTotal + Cells(i, 10).Value
FiftyTo100CustCount = FiftyTo100CustCount + 1
End If
' Process Avail Bal 100000 and over
If Cells(i, 10).Value > 100000 Then
OneHunderdandOverServiceChargeTotal = OneHunderdandOverServiceChargeTotal + Cells(i, 7).Value
OneHunderdandOverECRAmountTotal = OneHunderdandOverECRAmountTotal + Cells(i, 9).Value
OneHundredandOvertotalChargeTotal = OneHundredandOvertotalChargeTotal + Cells(i, 11).Value
OneHundredandOverAvailBalTotal = OneHundredandOverAvailBalTotal + Cells(i, 10).Value
OneHumdredAndOverCustomerCount = OneHumdredAndOverCustomerCount + 1
End If
End Sub
Sub TotalNewEnglandECR00105()
Dim i As Long
Dim TenTo50CustCount As Long
Dim FiftyTo100CustCount As Long
Dim OneHumdredAndOverCustomerCount As Long
Dim Tento50ECRAmountTotal As Long
Dim Fiftyto100ECRAmountTotal As Long
Dim OneHunderdandOverECRAmountTotal As Long
Dim Tento50AvailBalTotal As Long
Dim Fiftyto100AvailBalTotal As Long
Dim OneHundredandOverAvailBalTotal As Long
Dim Tento50TotalChargeTotal As Long
Dim Fiftyto100TotalChargeTotal As Long
Dim OneHundredandOvertotalChargeTotal As Long
Dim Tento50ServiceChargeTotal As Long
Dim Fiftyto100ServiceChargeTotal As Long
Dim OneHunderdandOverServiceChargeTotal As Long
Dim FinalRow As Long
'Process Avail Bal 10000 to 50000
If Cells(i, 10).Value > 10000 And Cells(i, 10).Value < 50000 Then
Tento50ServiceChargeTotal = Tento50ServiceChargeTotal + Cells(i, 7).Value
Tento50ECRAmountTotal = Tento50ECRAmountTotal + Cells(i, 9).Value
Tento50TotalChargeTotal = Tento50TotalChargeTotal + Cells(i, 11).Value
Tento50AvailBalTotal = Tento50AvailBalTotal + Cells(i, 10).Value
TenTo50CustCount = TenTo50CustCount + 1
End If
'Process Avail Bal 50000 to 100000
If Cells(i, 10).Value > 50000 And Cells(i, 10).Value < 100000 Then
Fiftyto100ServiceChargeTotal = Fiftyto100ServiceChargeTotal + Cells(i, 7).Value
Fiftyto100ECRAmountTotal = Fiftyto100ECRAmountTotal + Cells(i, 9).Value
Fiftyto100TotalChargeTotal = Fiftyto100TotalChargeTotal + Cells(i, 11).Value
Fiftyto100AvailBalTotal = Fiftyto100AvailBalTotal + Cells(i, 10).Value
FiftyTo100CustCount = FiftyTo100CustCount + 1
End If
' Process Avail Bal 100000 and over
If Cells(i, 10).Value > 100000 Then
OneHunderdandOverServiceChargeTotal = OneHunderdandOverServiceChargeTotal + Cells(i, 7).Value
OneHunderdandOverECRAmountTotal = OneHunderdandOverECRAmountTotal + Cells(i, 9).Value
OneHundredandOvertotalChargeTotal = OneHundredandOvertotalChargeTotal + Cells(i, 11).Value
OneHundredandOverAvailBalTotal = OneHundredandOverAvailBalTotal + Cells(i, 10).Value
OneHumdredAndOverCustomerCount = OneHumdredAndOverCustomerCount + 1
End If
End Sub
Sub TotalNewEnglandECR0011()
Dim i As Long
Dim TenTo50CustCount As Long
Dim FiftyTo100CustCount As Long
Dim OneHumdredAndOverCustomerCount As Long
Dim Tento50ECRAmountTotal As Long
Dim Fiftyto100ECRAmountTotal As Long
Dim OneHunderdandOverECRAmountTotal As Long
Dim Tento50AvailBalTotal As Long
Dim Fiftyto100AvailBalTotal As Long
Dim OneHundredandOverAvailBalTotal As Long
Dim Tento50TotalChargeTotal As Long
Dim Fiftyto100TotalChargeTotal As Long
Dim OneHundredandOvertotalChargeTotal As Long
Dim Tento50ServiceChargeTotal As Long
Dim Fiftyto100ServiceChargeTotal As Long
Dim OneHunderdandOverServiceChargeTotal As Long
Dim FinalRow As Long
'Process Avail Bal 10000 to 50000
If Cells(i, 10).Value > 10000 And Cells(i, 10).Value < 50000 Then
Tento50ServiceChargeTotal = Tento50ServiceChargeTotal + Cells(i, 7).Value
Tento50ECRAmountTotal = Tento50ECRAmountTotal + Cells(i, 9).Value
Tento50TotalChargeTotal = Tento50TotalChargeTotal + Cells(i, 11).Value
Tento50AvailBalTotal = Tento50AvailBalTotal + Cells(i, 10).Value
TenTo50CustCount = TenTo50CustCount + 1
End If
'Process Avail Bal 50000 to 100000
If Cells(i, 10).Value > 50000 And Cells(i, 10).Value < 100000 Then
Fiftyto100ServiceChargeTotal = Fiftyto100ServiceChargeTotal + Cells(i, 7).Value
Fiftyto100ECRAmountTotal = Fiftyto100ECRAmountTotal + Cells(i, 9).Value
Fiftyto100TotalChargeTotal = Fiftyto100TotalChargeTotal + Cells(i, 11).Value
Fiftyto100AvailBalTotal = Fiftyto100AvailBalTotal + Cells(i, 10).Value
FiftyTo100CustCount = FiftyTo100CustCount + 1
End If
' Process Avail Bal 100000 and over
If Cells(i, 10).Value > 100000 Then
OneHunderdandOverServiceChargeTotal = OneHunderdandOverServiceChargeTotal + Cells(i, 7).Value
OneHunderdandOverECRAmountTotal = OneHunderdandOverECRAmountTotal + Cells(i, 9).Value
OneHundredandOvertotalChargeTotal = OneHundredandOvertotalChargeTotal + Cells(i, 11).Value
OneHundredandOverAvailBalTotal = OneHundredandOverAvailBalTotal + Cells(i, 10).Value
OneHumdredAndOverCustomerCount = OneHumdredAndOverCustomerCount + 1
End If
End Sub
Sub TotalNewEnglandECR0013()
Dim i As Long
Dim TenTo50CustCount As Long
Dim FiftyTo100CustCount As Long
Dim OneHumdredAndOverCustomerCount As Long
Dim Tento50ECRAmountTotal As Long
Dim Fiftyto100ECRAmountTotal As Long
Dim OneHunderdandOverECRAmountTotal As Long
Dim Tento50AvailBalTotal As Long
Dim Fiftyto100AvailBalTotal As Long
Dim OneHundredandOverAvailBalTotal As Long
Dim Tento50TotalChargeTotal As Long
Dim Fiftyto100TotalChargeTotal As Long
Dim OneHundredandOvertotalChargeTotal As Long
Dim Tento50ServiceChargeTotal As Long
Dim Fiftyto100ServiceChargeTotal As Long
Dim OneHunderdandOverServiceChargeTotal As Long
Dim FinalRow As Long
'Process Avail Bal 10000 to 50000
If Cells(i, 10).Value > 10000 And Cells(i, 10).Value < 50000 Then
Tento50ServiceChargeTotal = Tento50ServiceChargeTotal + Cells(i, 7).Value
Tento50ECRAmountTotal = Tento50ECRAmountTotal + Cells(i, 9).Value
Tento50TotalChargeTotal = Tento50TotalChargeTotal + Cells(i, 11).Value
Tento50AvailBalTotal = Tento50AvailBalTotal + Cells(i, 10).Value
TenTo50CustCount = TenTo50CustCount + 1
End If
'Process Avail Bal 50000 to 100000
If Cells(i, 10).Value > 50000 And Cells(i, 10).Value < 100000 Then
Fiftyto100ServiceChargeTotal = Fiftyto100ServiceChargeTotal + Cells(i, 7).Value
Fiftyto100ECRAmountTotal = Fiftyto100ECRAmountTotal + Cells(i, 9).Value
Fiftyto100TotalChargeTotal = Fiftyto100TotalChargeTotal + Cells(i, 11).Value
Fiftyto100AvailBalTotal = Fiftyto100AvailBalTotal + Cells(i, 10).Value
FiftyTo100CustCount = FiftyTo100CustCount + 1
End If
' Process Avail Bal 100000 and over
If Cells(i, 10).Value > 100000 Then
OneHunderdandOverServiceChargeTotal = OneHunderdandOverServiceChargeTotal + Cells(i, 7).Value
OneHunderdandOverECRAmountTotal = OneHunderdandOverECRAmountTotal + Cells(i, 9).Value
OneHundredandOvertotalChargeTotal = OneHundredandOvertotalChargeTotal + Cells(i, 11).Value
OneHundredandOverAvailBalTotal = OneHundredandOverAvailBalTotal + Cells(i, 10).Value
OneHumdredAndOverCustomerCount = OneHumdredAndOverCustomerCount + 1
End If
End Sub