Help adjusting code to examine whole account groups first
This is a copy of the macro that i have written to automate some formatting
needed to work a computer generated report. The problem that i am running
into is that the program is currently set up to run line by line of the
report, but there are some accounts that take up several lines of the report.
I need a piece of code that will work one account at a time. Can anyone
help?
Code:
Sub TestMacro()
'
'TestMacro Macro
'Macro written by Edward Lane
'February 20, 2007
'
'Show's "Now Formatting" message
MsgBox "Now Formatting", vbInformation, " "
'Setting variables
Dim HotList As Range, OCList As Range 'The
first Veriable saved as Range will hold the range to be examined, the second
will act as the "counter" used to progress to each value in the range
Dim ActiveList As Range, Active As Range
Dim R5ActiveList As Range, R5Active As Range
Dim NatCityActiveList As Range, NatCityActive As Range
Dim KAtmDepositList As Range, KAtmDeposit As Range
Dim OAtmDepositList As Range, OAtmDeposit As Range
Dim HardHitList As Range, HardHit As Range
Dim TransAmountList As Range, TransAmount As Range
Dim PCCodeList As Range, PCCode As Range
Dim AccCodeList As Range, AccCode As Range
Set HotList = Worksheets("Hotlist").Columns(2)
'Sets range on "Hotlist" worksheet
Set OCList = Worksheets("OCList").Range("D2:D3198")
'Sets range on "OCList" worksheet
Set R5Active = Worksheets(1).Columns(15) 'Sets range where "R5"
can be found on "ASI-19 ActiveSheet"
Set NatCityActive = Worksheets(1).Columns(17) 'Sets range where
"NATIONAL CITY BANK" can be found on "ASI-19 ActiveSheet"
Set HardHit = Worksheets(1).Columns(10) 'Sets range where Current
Balance can be found on "ASI-19 ActiveSheet"
Set KAtmDeposit = Worksheets(1).Columns(16)
Set OAtmDeposit = Worksheets(1).Columns(9)
Set TransAmount = Worksheets(1).Columns(8)
Set PCCode = Worksheets(1).Columns(19)
Set AccCode = Worksheets(1).Columns(13)
'Define ItmSeq Range
With Sheets(1)
Set OAtmDepositList = Range("I2:I" & Cells(Rows.Count,
"I").End(xlUp).Row)
End With
'Fill AtmDepositList Array with Routing numbers
With Sheets(1)
Set KAtmDepositList = Range("P2:P" & Cells(Rows.Count,
"P").End(xlUp).Row)
End With
'Fill ActiveList Array
With Sheets(1)
Set ActiveList = Range("G2:G" & Cells(Rows.Count, "G").End(xlUp).Row)
End With
'Define R5 Range
With Sheets(1)
Set R5ActiveList = Range("O2:O" & Cells(Rows.Count,
"O").End(xlUp).Row)
End With
'Define Bank Info Range
With Sheets(1)
Set NatCityActiveList = Range("Q2:Q" & Cells(Rows.Count,
"Q").End(xlUp).Row)
End With
'Define Array of Current Balances in Account
With Sheets(1)
Set HardHitList = Range("J2:J" & Cells(Rows.Count, "J").End(xlUp).Row)
End With
'Define Array of Deposit Amount
With Sheets(1)
Set TransAmountList = Range("H2:H" & Cells(Rows.Count,
"H").End(xlUp).Row)
End With
'Define Array of P/C Codes
With Sheets(1)
Set PCCodeList = Range("S2:S" & Cells(Rows.Count, "S").End(xlUp).Row)
End With
'Define List of Account Codes
With Sheets(1)
Set AccCodeList = Range("M2:M" & Cells(Rows.Count, "M").End(xlUp).Row)
End With
For Each KAtmDeposit In KAtmDepositList
If KAtmDeposit = 55555555 Then
KAtmDeposit.EntireRow.Select
Selection.Font.ColorIndex = 6
Selection.Font.Bold = True
With Selection.Interior
.ColorIndex = 10
.Pattern = xlSolid
End With
KAtmDeposit.Offset(0, -15).Select
ActiveCell.Value = "ATM Deposit"
End If
Next
For Each OAtmDeposit In OAtmDepositList
If InStr(OAtmDeposit, "91000") Then
OAtmDeposit.EntireRow.Select
Selection.Font.ColorIndex = 6
Selection.Font.Bold = True
With Selection.Interior
.ColorIndex = 10
.Pattern = xlSolid
End With
OAtmDeposit.Offset(0, -8).Select
ActiveCell.Value = "ATM Deposit"
End If
Next
'Compairing data
For Each Active In ActiveList 'For loop
that uses the account number stored as the value "Active" to compaire to
account numbers found on "Hotlist" and "OCList" worksheets
If Application.CountIf(OCList, Active) 0 Then 'CountIf
return's the number of times an item matches values in a given range, in this
case, if the value stored as "Active" shows up on the "OCList" range, it will
return a value of 1
Active.EntireRow.Select 'Selects the
entire row upon which the data stored in "Active" finds itself on the "ASI-19
ActiveSheet"
With Selection.Interior 'Takes the
selection and format's it accordingly, With statement used when coloring the
interior of the row, not the font (i'm not sure why yet, has something to do
with performing more than one action on the same object)
.ColorIndex = 6
.Pattern = xlSolid
End With 'End of
formatting With Statement
Active.Offset(0, -6).Select 'Selects
Cell at the beginning of the Row
ActiveCell.Value = "OCList" 'In this
case, after the first cell is selected, "OCList" is placed in the active cell
to make it easy to locate while working the report
End If 'End If
Statement
If Application.CountIf(HotList, Active) 0 Then 'The above
process is repeated, just replace "OCList" with "Hotlist"
Active.EntireRow.Select 'Note: The
order of these If statements are importent because there could be some
overlap between hotlist and oclist items, and the hotlist items should take
precidence, so you place the hotlist operation after the oclist operation to
insure that hotlist formatting will overwright any oclist info
With Selection.Interior
.ColorIndex = 45
.Pattern = xlSolid
End With
Active.Offset(0, -6).Select
ActiveCell.Value = "HOTLIST"
End If
If Active = 11110000 And Active <= 11110999 Then 'This
section simply compaires the data stored as "Active" between account numbers
known to be "cash transactions", and therefor do not need to be reviewed (as
they are reviewed by another party)
Active.EntireRow.Select
Selection.Font.ColorIndex = 46
Selection.Font.Bold = True
Active.Offset(0, -6).Select
ActiveCell.Value = "Cash"
End If
Next 'Progress
For Loop onto the next value found in the ActiveList range
'Looks for "R5" in Rules Column
For Each R5Active In R5ActiveList 'Same
process as above, only different Variable names used to represent the shift
from Column G to Column O
If InStr(R5Active, "R5") Then 'InStr is a
built in funtion to VBA that will compaire a text value with others in a
range and return true if true
R5Active.EntireRow.Select 'Again,
selecting the entire row where the information was found
With Selection.Interior 'Formatting
.ColorIndex = 3
.Pattern = xlSolid
End With
R5Active.Offset(0, -14).Select 'Selecting
the first cell in the row (Note: is this case, because Column "O" is 14
column's to the left of Column "A" vs. Column "G" in the "Hotlist" and
"OCList" operations, -14 (the number of columns left of the active one) was
used instead of -6
ActiveCell.Value = "R5"
End If
Next
'Looks for "NATIONAL CITY BANK" in BankInfo Column
For Each NatCityActive In NatCityActiveList 'Same
process as above, only different Variable names used to represent the shift
from Column "O" to Column "Q"
If InStr(NatCityActive, "NATIONAL CITY BANK") Or
InStr(NatCityActive, "HARBOR FEDERAL SAVINGS") Then 'Start If Statement
NatCityActive.EntireRow.Select
Selection.Font.ColorIndex = 9
Selection.Font.Bold = True
NatCityActive.Offset(0, -16).Select
ActiveCell.Value = "On Us Check"
End If 'End If
Statement
Next 'End For Loop
'Looks at Current Balance and determines if it is less than half of the
deposit amount
For Each HardHit In HardHitList
If HardHit < HardHit.Offset(0, -2) / 2 And HardHit.Offset(0, -4) =
"C" Then 'If true and it is the "Credit" line, then the program will color
and bold font
HardHit.EntireRow.Select
Selection.Font.ColorIndex = 2
Selection.Font.Bold = True
With Selection.Interior
.ColorIndex = 1
.Pattern = xlSolid
End With
HardHit.Offset(0, -9).Select
ActiveCell.Value = "Hard Hit"
End If
Next
For Each TransAmount In TransAmountList
If TransAmount * 2 < TransAmount.Offset(0, -3) And
TransAmount.Offset(0, -2) = "C" Then
TransAmount.EntireRow.Select
Selection.Font.ColorIndex = 12
Selection.Font.Bold = True
With Selection.Interior
.ColorIndex = 1
.Pattern = xlSolid
End With
TransAmount.Offset(0, -7).Select
ActiveCell.Value = "EXCLUDE(AVE BAL 2X DEP AMOUNT OR 3x CUR BAL)"
End If
If TransAmount * 3 < TransAmount.Offset(0, 2) And
TransAmount.Offset(0, -2) = "C" Then
TransAmount.EntireRow.Select
Selection.Font.ColorIndex = 12
Selection.Font.Bold = True
With Selection.Interior
.ColorIndex = 1
.Pattern = xlSolid
End With
TransAmount.Offset(0, -7).Select
ActiveCell.Value = "EXCLUDE(AVE BAL 2X DEP AMOUNT OR 3x CUR BAL)"
End If
Next
For Each PCCode In PCCodeList
If PCCode = "10" Or PCCode = "915" Then
PCCode.EntireRow.Select
Selection.Font.ColorIndex = 1
Selection.Font.Bold = True
With Selection.Interior
.ColorIndex = 13
.Pattern = xlSolid
End With
PCCode.Offset(0, -18).Select
ActiveCell.Value = "EXCLUDE(CLOSED ACCOUNT OR CREDIT MEMO)"
End If
Next
For Each AccCode In AccCodeList
If AccCode = "B" Or AccCode = "M" Or AccCode = "I" Then
AccCode.EntireRow.Select
Selection.Font.ColorIndex = 1
Selection.Font.Bold = True
With Selection.Interior
.ColorIndex = 21
.Pattern = xlSolid
End With
AccCode.Offset(0, -12).Select
ActiveCell.Value = "CALMS/AGILETICS"
End If
Next
Rows("2:2").Select 'Selects Row 2
ActiveWindow.FreezePanes = True 'Freeze's Pane so Column Names
are always present
Range("A2").Select 'Select's a single cell and
prepares to sort
Cells.Select 'Selects all cells on worksheet
Cells.EntireColumn.AutoFit 'Autofit's all Columns to adjust
for size of data
Range("A2").Select 'Selects first cell to work on
sheet
End Sub
|
