PDA

View Full Version : Solved: There must be a better way to code this



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

Bob Phillips
10-18-2006, 10:30 AM
Do all those macros do the same thing?

SamT
10-18-2006, 10:33 AM
Could you use the Continue-on-Next-Line function (" _"; SpaceUnderline) occasioanlly?
Those long lines of code make me have to scroll up-down-sideways to read each line.

Thanks
SamT :blush

austenr
10-18-2006, 10:33 AM
Hi Bob, yes they do.

SamT
10-18-2006, 11:01 AM
Pseudo
Dim ServiceCharge As Long
Dim ThisOne as Long
ThisOne = Cells(i, 10).Value

Select Case ThisOne

Case < 5000
ServiceCharge = Tento50ServiceChargeTotal 'By Reference?
ECR = Tento50ECRAmountTotal 'By Reference?
Etc. = TenTopFiftyEtc 'By Reference?

Case <100000
ServiceCharge = Fiftyto100ServiceChargeTotal
Etc

Case Etc.
End Select

Sub ProcessAnyBalance
ServiceCharge = ServiceCharge+ Cells(i, 7).Value
ECR = ECR + Cells(i, 9).Value
Etc

'If you do this "By Reference" you're done, otherwise
' Select Case it back to the loooong names.




SamT :dunno

Bob Phillips
10-18-2006, 11:08 AM
Hi Bob, yes they do.

Then why not just have the one, any one, and call that one for each value?

austenr
10-18-2006, 11:10 AM
Hi Sam. your code does not seem to work. Bob, Example please. Thanks

austenr
10-18-2006, 11:54 AM
Ok, i want to use the SELECT CASE method, how can you test for multiple conditions and how do you add other fields to counters/accumulators?

if the amount is < 50000, then i need to add to accumulators from different fields in that row not just the total.

Bob Phillips
10-18-2006, 12:40 PM
As a very simplistic example



Select Case Cells(i, 8).Value
Case "0.0096": TotalNewEngland Cells(i, 99).Value
Case "0.0105", "0.011": TotalNewEngland Cells(i, 100).Value
End Select

Sub TotalNewEngland(Val As Double)
'Process Avail Bal 10000 to 50000
If Cells(i, 10).Value < 50000 Then
Tento50ServiceChargeTotal = Tento50ServiceChargeTotal + _
Cells(i, 7).Value + Val
Tento50ECRAmountTotal = Tento50ECRAmountTotal + _
Cells(i, 9).Value
Tento50TotalChargeTotal = Tento50TotalChargeTotal + _
Cells(i, 11).Value
Tento50AvailBalTotal = Tento50AvailBalTotal + C_
ells(i, 10).Value
TenTo50CustCount = TenTo50CustCount + 1
End If
End Sub

austenr
10-18-2006, 03:30 PM
Thanks Bob. Will give it a try. One more thing, what does this code do?

TotalNewEngland Cells(i, 99).Value

Bob Phillips
10-18-2006, 03:43 PM
It calls that macro with the value in Cell(i,99) as a parameter. If you look at the macro, you will see it has an argument which is used in the code.

austenr
10-18-2006, 05:42 PM
I tried to use the code on the sample workbook, I get an error saying "application or Object defined error". I am attaching the amended code I used.

Andy Pope
10-19-2006, 05:37 AM
Variable i in routine aaa requires a value greater than zero.

Variable i in function TotalNewEngland required declaration and value.
In fact it probably needs to be passed as an argument.

The continuation line needs to be before the cell object

Tento50AvailBalTotal = Tento50AvailBalTotal + _
Cells(i, 10).Value

austenr
10-19-2006, 05:44 AM
Thanks Andy. Does there need to be an entry in i,99 and i,100 for Bobs code to execute? Sorry but I am not understanding the AAA macro. Thanks

austenr
10-19-2006, 05:51 AM
It is erroring on the Select Case Cells(i, 9).Value line with the error being:

1004 "application defined or object defined error"

Bob Phillips
10-19-2006, 05:57 AM
What did you change after Andy's post?

Andy Pope
10-19-2006, 06:12 AM
Hopefully this now does some of what you want.

BTW all those variables declared in each routine where being cleared every time the routine was exited as the scope of those variables was restricted to the routine. And you did not appear to be storing the value anywhere.

austenr
10-19-2006, 06:37 AM
Excellent!!! Just what I needed. Thanks so much

austenr
10-19-2006, 07:55 AM
Bob, I did not change anything.

austenr
10-19-2006, 08:02 AM
Using Andy's code if I try to add the line in red i get a type mismatch:

If the line in red is removed, then the macro runs. Also I have a record in the attached spreadsheet that is over 100000 but does not show up on the "NE ECR" page.

Anyones help is appreciated.

With Sheets("NE ECR")
.Cells(5, 6).Value = TenTo50CustCount
.Cells(6, 6).Value = FiftyTo100CustCount
.Cells(7, 6).Value = OneHundredAndOverCustomerCount
.Cells(5, 7).Value = Tento50AvailBalTotal
End With

Andy Pope
10-19-2006, 12:02 PM
The +100k is not included as the loop stop at row 12 as A13 is empty.


Do While .Cells(i, 1) <> ""

The type mismatch is caused by running the aaa routine when the NE ECR is active.
This change will use the New England sheet explicitly.

Sub TotalNewEngland(i)

With Sheets("New England")
If .Cells(i, 10).Value > 10000 _
And .Cells(i, 10).Value < 50000 Then
'
' cut for brevity
'
End If
End With
End Sub

austenr
10-19-2006, 12:29 PM
Is there a way to make it run separatly for each ECR number? In other words, have every choice on one sheet and as it encounters it (0.0096, 0.0105, 0.011, 0.013) add to the appropriate totals? I just need the logic on how to tell it which way to go and what totals to add to. Same concept just do some sort of mini routine that the above numbers will trigger. This is really great and I appreciate your and everyones help getting this set up. Thanks Andy and Bob and others.

Andy Pope
10-19-2006, 12:50 PM
Sub aaa()
Dim i As Long
Dim vntArray As Variant
Dim lngIndex As Long

vntArray = Array(0.0096, 0.0105, 0.011, 0.013)

For lngIndex = LBound(vntArray) To UBound(vntArray)
TenTo50CustCount = 0
FiftyTo100CustCount = 0
OneHundredAndOverCustomerCount = 0
Tento50AvailBalTotal = 0

With Sheets("New England")
i = 2
Do While .Cells(i, 1) <> ""
If .Cells(i, 8).Value = vntArray(lngIndex) Then
TotalNewEngland i
End If
i = i + 1
Loop
End With

With Sheets("NE ECR")
.Cells(5, 6).Value = TenTo50CustCount
.Cells(6, 6).Value = FiftyTo100CustCount
.Cells(7, 6).Value = OneHundredAndOverCustomerCount
.Cells(5, 7).Value = Tento50AvailBalTotal
End With

Next

End Sub


But it is unclear to mean where the various outputs should go for each loop.
Currently only the last run through the loop is being stored.

austenr
10-20-2006, 06:03 AM
Thanks Andy. I can make seperate counters(totals) for each 0.0096, etc and populate the sheet that way. Thanks again for all of your help. :clap:

Andy Pope
10-20-2006, 06:31 AM
Where should the information for the 0.0096 items go.

If you can explain where output should go we can incorporate it into the looping.

austenr
10-20-2006, 07:14 AM
Hi Andy. I am attaching the totals page where the data goes. The 0.0096 and other totals are broken out into separate rows but the 0.0096 goes in the Standard ECR column. The fields that are not populated are calculated fields that I will do. Thanks again.

Andy Pope
10-20-2006, 07:33 AM
Create an array to store the top row for each section

austenr
10-20-2006, 07:39 AM
Hate to ask but why did the numerical amounts not show up with this change. By numerical i mean avail balance, etc. This is really great. Could you explain what I need to do to get the amounts to show up as well? You are really good!!!

Andy Pope
10-20-2006, 07:54 AM
Because I have not put any code in there to do that ;)

You need to expand on the end section of aaa

With Sheets("NE ECR")
.Cells(vntOutRow(lngIndex), 6).Value = TenTo50CustCount
.Cells(vntOutRow(lngIndex) + 1, 6).Value = FiftyTo100CustCount
.Cells(vntOutRow(lngIndex) + 2, 6).Value = OneHundredAndOverCustomerCount
.Cells(vntOutRow(lngIndex), 7).Value = Tento50AvailBalTotal

' output other accumulated values
' modify row and cell value to suit
.Cells(vntOutRow(lngIndex), 7).Value = _
Tento50ServiceChargeTotal

End With

austenr
10-20-2006, 09:38 AM
Thanks i got it now i think.

austenr
10-20-2006, 12:40 PM
Well i thought i had it. When I added more cells for service charge, total charge, etc. it put it on sections where it did not belong. Sample attached again. Thanks .

austenr
10-22-2006, 10:16 AM
OK This is working as I want except for one thing. In the sheet called "New England" in the attached workbook, the macro is not picking up the row highlighted in yellow. All of the other rows are being picked up fine. Can anyone help? Thanks :banghead:

austenr
10-22-2006, 01:48 PM
I solved it. Data was formatted wrong. solved.