Looping/Code Consolidation

[Cjluke]

I am running into an error in a workbook telling me that my code is too long. Rather than just taking the easy route and splitting the process between two different sub procedures, I was wondering if anyone had any ideas about consolidating the following code. Basically, this same code will appear about 26 times at this point. Thanks for the help in advance. If it would help to have the actual file, Let me know and I'll post it. - Charles



For j = 2 To ws1.Cells(Rows.Count, 1).End(xlUp).Row()
If ws1.Cells(j, "J") = 1 Then
If ws1.Cells(j, "H") = "A. G. EDWARDS" Then
ws1.Cells(j, "K") = "TRADE"
End If
End If
If ws1.Cells(j, "K") = "TRADE" Then
If ws1.Cells(j, "I") = "U.S. AGENCY DEBENTURES" Then
ws1.Cells(j, "L") = 1
End If
End If
If ws1.Cells(j, "K") = "TRADE" Then
If ws1.Cells(j, "I") = "TAXABLE MUNICIPALS" Then
ws1.Cells(j, "L") = 2
End If
End If
If ws1.Cells(j, "K") = "TRADE" Then
If ws1.Cells(j, "I") = "COMMERCIAL PAPER - DISCOUNT" Then
ws1.Cells(j, "L") = 3
End If
End If
If ws1.Cells(j, "K") = "TRADE" Then
If ws1.Cells(j, "I") = "CORPORATE BONDS" Then
ws1.Cells(j, "L") = 4
End If
End If
If ws1.Cells(j, "K") = "TRADE" Then
If ws1.Cells(j, "I") = "U.S. AGENCY DISCOUNTS/STRIPS" Then
ws1.Cells(j, "L") = 5
End If
End If
If ws1.Cells(j, "K") = "TRADE" Then
If ws1.Cells(j, "I") = "Mortgages" Then
ws1.Cells(j, "L") = 6
End If
End If
If ws1.Cells(j, "K") = "TRADE" Then
If ws1.Cells(j, "I") = "MUNICIPAL BONDS" Then
ws1.Cells(j, "L") = 7
End If
End If
If ws1.Cells(j, "K") = "TRADE" Then
If ws1.Cells(j, "I") = "U.S. TREASURY BILLS" Then
ws1.Cells(j, "L") = 8
End If
End If
If ws1.Cells(j, "K") = "TRADE" Then
If ws1.Cells(j, "I") = "U.S. TREASURY NOTES/BONDS" Then
ws1.Cells(j, "L") = 9
End If
End If
If ws1.Cells(j, "K") = "TRADE" Then
If ws1.Cells(j, "I") = "VRDN" Then
ws1.Cells(j, "L") = 10
End If
End If
If ws1.Cells(j, "L") > 0 Then
If ws1.Cells(j, "D") > 0 Then
ws1.Cells(j, "M") = ws1.Cells(j, "D")
Else
ws1.Cells(j, "M") = ws1.Cells(j, "C")
End If
End If
If ws1.Cells(j, "M") >= 1000000 Then
ws1.Cells(j, "N") = "1"
End If

[Bob Phillips]

That can be shortened



For j = 2 To ws1.Cells(Rows.Count, 1).End(xlUp).Row()
If ws1.Cells(j, "J") = 1 Then
If ws1.Cells(j, "H") = "A. G. EDWARDS" Then
ws1.Cells(j, "K") = "TRADE"
End If
Select Case ws1.Cells(j, "I").Value
Case "U.S. AGENCY DEBENTURES"
ws1.Cells(j, "L") = 1
Case "TAXABLE MUNICIPALS"
ws1.Cells(j, "L") = 2
Case "COMMERCIAL PAPER - DISCOUNT"
ws1.Cells(j, "L") = 3
Case "CORPORATE BONDS"
ws1.Cells(j, "L") = 4
Case "U.S. AGENCY DISCOUNTS/STRIPS"
ws1.Cells(j, "L") = 5
Case "Mortgages"
ws1.Cells(j, "L") = 6
Case "MUNICIPAL BONDS"
ws1.Cells(j, "L") = 7
Case "U.S. TREASURY BILLS"
ws1.Cells(j, "L") = 8
Case "U.S. TREASURY NOTES/BONDS"
ws1.Cells(j, "L") = 9
Case "VRDN"
ws1.Cells(j, "L") = 10
End Select
End If
If ws1.Cells(j, "L") > 0 Then
If ws1.Cells(j, "D") > 0 Then
ws1.Cells(j, "M") = ws1.Cells(j, "D")
Else
ws1.Cells(j, "M") = ws1.Cells(j, "C")
End If
End If
If ws1.Cells(j, "M") >= 1000000 Then
ws1.Cells(j, "N") = "1"
End If


but if it is repeated 26 times, put it in its own routine and call it.

[Cjluke]

How do I do that? Also, the cell references change each time the code is reapeated. Is there a way to make sure that happens? Thanks a lot for responding. I saw your earlier posts. You definitely know whats up with VBA in excel. - Charles

[Bob Phillips]

You do it like this



Sub MainProc()

'do some stuff
Call RepeatingCodeProc

'do som more stuff
Call RepeatingCodeProc

End Sub

Sub RepeatingCodeProc()

'the repeatable code
End Sub


Where the cell references change, you pass the changing cells as parameter arguments to the celled propcedure, like thius



Sub MainProc()

'do some stuff
Call RepeatingCodeProc(Range("A1"))

'do som more stuff
Call RepeatingCodeProcRange("B1")

End Sub

Sub RepeatingCodeProc(rng As Range)

If rng.Value > 1 Then

rng.Offset(0, 1).Value = rng.Value
Else

MsgBox "Invalid value"
End If

End Sub

[Cjluke]

So, basically, that is just sliding all the cell references 1 column to the left? I am a little confused, and not too seasoned in VBA yet. For instance, I have the following two versions of the repeating procedure:


'First Repeating Procedure (Initial Cell References)
'A.G.Edwards

For j = 2 To ws1.Cells(Rows.Count, 1).End(xlUp).Row()
If ws1.Cells(j, "J") = 1 Then
If ws1.Cells(j, "H") = "A. G. EDWARDS" Then
ws1.Cells(j, "K") = "TRADE"
End If
End If
If ws1.Cells(j, "K") = "TRADE" Then
If ws1.Cells(j, "I") = "U.S. AGENCY DEBENTURES" Then
ws1.Cells(j, "L") = 1
End If
End If
If ws1.Cells(j, "K") = "TRADE" Then
If ws1.Cells(j, "I") = "TAXABLE MUNICIPALS" Then
ws1.Cells(j, "L") = 2
End If
End If
If ws1.Cells(j, "K") = "TRADE" Then
If ws1.Cells(j, "I") = "COMMERCIAL PAPER - DISCOUNT" Then
ws1.Cells(j, "L") = 3
End If
End If
If ws1.Cells(j, "K") = "TRADE" Then
If ws1.Cells(j, "I") = "CORPORATE BONDS" Then
ws1.Cells(j, "L") = 4
End If
End If
If ws1.Cells(j, "K") = "TRADE" Then
If ws1.Cells(j, "I") = "U.S. AGENCY DISCOUNTS/STRIPS" Then
ws1.Cells(j, "L") = 5
End If
End If
If ws1.Cells(j, "K") = "TRADE" Then
If ws1.Cells(j, "I") = "Mortgages" Then
ws1.Cells(j, "L") = 6
End If
End If
If ws1.Cells(j, "K") = "TRADE" Then
If ws1.Cells(j, "I") = "MUNICIPAL BONDS" Then
ws1.Cells(j, "L") = 7
End If
End If
If ws1.Cells(j, "K") = "TRADE" Then
If ws1.Cells(j, "I") = "U.S. TREASURY BILLS" Then
ws1.Cells(j, "L") = 8
End If
End If
If ws1.Cells(j, "K") = "TRADE" Then
If ws1.Cells(j, "I") = "U.S. TREASURY NOTES/BONDS" Then
ws1.Cells(j, "L") = 9
End If
End If
If ws1.Cells(j, "K") = "TRADE" Then
If ws1.Cells(j, "I") = "VRDN" Then
ws1.Cells(j, "L") = 10
End If
End If
If ws1.Cells(j, "L") > 0 Then
If ws1.Cells(j, "D") > 0 Then
ws1.Cells(j, "M") = ws1.Cells(j, "D")
Else
ws1.Cells(j, "M") = ws1.Cells(j, "C")
End If
End If
If ws1.Cells(j, "M") >= 1000000 Then
ws1.Cells(j, "N") = "1"
End If

'Second Repeating Procedure (2nd Set of cell references)
'American General

If ws1.Cells(j, "J") = 1 Then
If ws1.Cells(j, "H") = "AMERICAN GENERAL FINANCE" Then
ws1.Cells(j, "O") = "TRADE"
End If
End If
If ws1.Cells(j, "O") = "TRADE" Then
If ws1.Cells(j, "I") = "U.S. AGENCY DEBENTURES" Then
ws1.Cells(j, "P") = 1
End If
End If
If ws1.Cells(j, "O") = "TRADE" Then
If ws1.Cells(j, "I") = "TAXABLE MUNICIPALS" Then
ws1.Cells(j, "P") = 2
End If
End If
If ws1.Cells(j, "O") = "TRADE" Then
If ws1.Cells(j, "I") = "COMMERCIAL PAPER - DISCOUNT" Then
ws1.Cells(j, "P") = 3
End If
End If
If ws1.Cells(j, "O") = "TRADE" Then
If ws1.Cells(j, "I") = "CORPORATE BONDS" Then
ws1.Cells(j, "P") = 4
End If
End If
If ws1.Cells(j, "O") = "TRADE" Then
If ws1.Cells(j, "I") = "U.S. AGENCY DISCOUNTS/STRIPS" Then
ws1.Cells(j, "P") = 5
End If
End If
If ws1.Cells(j, "O") = "TRADE" Then
If ws1.Cells(j, "I") = "Mortgages" Then
ws1.Cells(j, "P") = 6
End If
End If
If ws1.Cells(j, "O") = "TRADE" Then
If ws1.Cells(j, "I") = "MUNICIPAL BONDS" Then
ws1.Cells(j, "P") = 7
End If
End If
If ws1.Cells(j, "O") = "TRADE" Then
If ws1.Cells(j, "I") = "U.S. TREASURY BILLS" Then
ws1.Cells(j, "P") = 8
End If
End If
If ws1.Cells(j, "O") = "TRADE" Then
If ws1.Cells(j, "I") = "U.S. TREASURY NOTES/BONDS" Then
ws1.Cells(j, "P") = 9
End If
End If
If ws1.Cells(j, "O") = "TRADE" Then
If ws1.Cells(j, "I") = "VRDN" Then
ws1.Cells(j, "P") = 10
End If
End If
If ws1.Cells(j, "P") > 0 Then
If ws1.Cells(j, "D") > 0 Then
ws1.Cells(j, "Q") = ws1.Cells(j, "D")
Else
ws1.Cells(j, "Q") = ws1.Cells(j, "C")
End If
End If
If ws1.Cells(j, "Q") >= 1000000 Then
ws1.Cells(j, "R") = "1"
End If


I need those cell references to be able to shift to the correct references. Additionally, that code you sent me in your first response is awesome.

[Bob Phillips]

Sub MainProc()
'A.G.Edwards

For j = 2 To ws1.Cells(Rows.Count, 1).End(xlUp).Row()

If ws1.Cells(j, "J") = 1 Then

If ws1.Cells(j, "H") = "A. G. EDWARDS" Then

ws1.Cells(j, "K") = "TRADE"
Call CheckValues("K")
ElseIf ws1.Cells(j, "H") = "AMERICAN GENERAL FINANCE" Then

ws1.Cells(j, "O") = "TRADE"
Call CheckValues("O")
End If
End If

Next j

End Sub

Private Sub CheckValues(col As String)

If ws1.Cells(j, col).Value = "TRADE" Then
If ws1.Cells(j, "I").Value = "U.S. AGENCY DEBENTURES" Then
ws1.Cells(j, col.Offset(0,1).Value = 1
End If
End If
If ws1.Cells(j, col).Value = "TRADE" Then
Select Case ws1.Cells(j, "I").Value
Case "U.S. AGENCY DEBENTURES"
ws1.Cells(j, col).Offset(0, 1).Value = 1
Case "TAXABLE MUNICIPALS"
ws1.Cells(j, col).Offset(0, 1).Value = 2
Case "COMMERCIAL PAPER - DISCOUNT"
ws1.Cells(j, col).Offset(0, 1).Value = 3
Case "CORPORATE BONDS"
ws1.Cells(j, col).Offset(0, 1).Value = 4
Case "U.S. AGENCY DISCOUNTS/STRIPS"
ws1.Cells(j, col).Offset(0, 1).Value = 5
Case "Mortgages"
ws1.Cells(j, col).Offset(0, 1).Value = 6
Case "MUNICIPAL BONDS"
ws1.Cells(j, col).Offset(0, 1).Value = 7
Case "U.S. TREASURY BILLS"
ws1.Cells(j, col).Offset(0, 1).Value = 8
Case "U.S. TREASURY NOTES/BONDS"
ws1.Cells(j, col).Offset(0, 1).Value = 9
Case "VRDN"
ws1.Cells(j, col).Offset(0, 1).Value = 10
End Select
End If
If ws1.Cells(j, "P") > 0 Then
If ws1.Cells(j, "D") > 0 Then
ws1.Cells(j, col).Offset(0, 2).Value = ws1.Cells(j, "D")
Else
ws1.Cells(j, col).Offset(0, 2).Value = ws1.Cells(j, "C")
End If
End If
If ws1.Cells(j, col).Offset(0, 2).Value >= 1000000 Then
ws1.Cells(j, col).Offset(0, 3).Value = "1"
End If
End Sub

[Cjluke]

Thanks...this is really awesome. I appreciate your time in helping me out.