VBA code for a routine process

[Stefan15]

Hello All

Please i need a VBA code for the routine process below, let me know if your required further details. also attached is a sample of the report.



Convert to numbers Group 1, Group 2 and Group 3 (columns AC, AD, AE) by selecting each column , then “Data” then “Text to column” then Next, Next and Finish
Convert From Range and To Range (columns Z and AA) by selecting each column, then“Data” then “Text to column” then Next, Next and Finish
Label column AF as TOTAL
Add formula to column AF =IF(AND(AC2="",AD2="",AE2=""),"Blank",(SUM(AC2:AE2))) and copy that formula to the end of the report
Label column AG as OUT OF ORDER
Label column AH as Reviewer Notes
Add Filters to all columns
Filter AF by Blank and add FALSE to column AG. Under AH add User Not part of approval rules
Filter AF by 0 add FALSE to column AG. Under AH add No approval Rules set up
Filter AF by 2 & 3 add FALSE to column AG. Under AH add Multiple approvers required
Filter AF by 1 these are the potential out of order items

If H, I J, L, M & N (create, modify and approve single or templates) are all blank, add FALSE to column AG. Under AH add No User Permissions
If Seg Payments and Seg Recurring (columns O & P) are both TRUE (client cannot make and check) add FALSE to column AG. Under AH add Segregation of user permissions
If Seg Payments and Seg Recurring (columns O & P) are both FALSE (client can make and check) add TRUE to column AG. Under AH add No Segregation of user permissions
If To and From amounts (columns AA & AB) are less than $10,000 add FALSE to column AG. Under AH add To amount less than $10,000


Confirm Out of Order column AG have no blanks as input of TRUE or FALSE must be entered for each line.
If any are TRUE, there is an out of order that must be investigated.
If all are FALSE, the review of AT permissions is complete and ready to report to Davide/Michelle once the full review is done.


Thanks :clap::clap::clap::clap::clap::clap::clap::clap:

[offthelip]

That is a project not a question.

[SamT]

@ Stefan

WHAT?!?!?!?

[Paul_Hossler]

Record a macro that does all of that, then post it and a workbook with some data

People will be glad to offer suggestion as to how you can clean up the recorded macro and generalize it

[Stefan15]

Hi Guys




I tried to do the coding myself but got stuck at step 8 ,I want to do a for loop through each filtered cell in column AF and where there is "Blank" Input "False" in column AG and "User Not part of approval rules" in column AH.

My for loop code does not seems to work? -(see my code below;)




Sub Account_Transfer()



[
ActiveSheet.Range("AD:AD").Select
Selection.TextToColumns Destination:=Range("AC1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True

ActiveSheet.Range("AE:AE").Select
Selection.TextToColumns Destination:=Range("AC1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True




ActiveSheet.Range("Z:Z").Select
Selection.TextToColumns Destination:=Range("AC1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True



ActiveSheet.Range("AA:AA").Select
Selection.TextToColumns Destination:=Range("AC1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True


ActiveSheet.Range("AF1").Value = "Total"
ActiveSheet.Range("AF2").Select
ActiveCell.Formula = "=IF(AND(AC2="""",AD2="""",AE2=""""),""Blank"",(SUM(AC2:AE2)))"
ActiveCell.AutoFill Destination:=Range("AF2:AF" & Range("D2").End(xlDown).Row)


ActiveSheet.Range("AG1").Value = "Out Of Order"
ActiveSheet.Range("AH1").Value = "Reviewer Note"


ActiveSheet.Range("A1:AH1").Select
Selection.AutoFilter
ActiveSheet.Range("AF1").AutoFilter field:=32, Criteria1:="Blank"


For Each Rng In Range("AF:AF")
If Rng.Value = "Blank" Then
Range("AG2").Value = "FALSE"
'Range("AH2:AH").SpecialCells(xlCellTypeVisible).Value = "User Not part of approval rules"


End If


Next Rng




End Sub]



I also recorded the entire steps, (see below)

{ Columns("AC:AC").Select
Selection.TextToColumns Destination:=Range("AC1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
Columns("AD:AD").Select
Selection.TextToColumns Destination:=Range("AD1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
Columns("AE:AE").Select
Selection.TextToColumns Destination:=Range("AE1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
Columns("Z:Z").Select
Selection.TextToColumns Destination:=Range("Z1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
Columns("AA:AA").Select
Selection.TextToColumns Destination:=Range("AA1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
Range("AF1").Select
Selection.NumberFormat = "General"
ActiveCell.FormulaR1C1 = "Total"
Range("AF2").Select
ActiveCell.FormulaR1C1 = _
"=IF(AND(RC[-3]="""",RC[-2]="""",RC[-1]=""""),""Blank"",(SUM(RC[-3]:RC[-1])))"
Range("AF2").Select
Selection.AutoFill Destination:=Range("AF2:AF68916"), Type:=xlFillDefault
Range("AF2:AF68916").Select
Range("AG1").Select
Selection.NumberFormat = "General"
ActiveCell.FormulaR1C1 = "Out of Order"
Range("AH1").Select
Selection.NumberFormat = "General"
ActiveCell.FormulaR1C1 = "Reviewer Notes"
Range("A1:AH1").Select
Range("AH1").Activate
Selection.AutoFilter
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 9
ActiveWindow.ScrollColumn = 10
ActiveWindow.ScrollColumn = 11
ActiveWindow.ScrollColumn = 12
ActiveWindow.ScrollColumn = 13
ActiveWindow.ScrollColumn = 14
ActiveWindow.ScrollColumn = 15
ActiveWindow.ScrollColumn = 16
ActiveWindow.ScrollColumn = 17
ActiveWindow.ScrollColumn = 18
ActiveWindow.ScrollColumn = 19
ActiveWindow.ScrollColumn = 20
ActiveSheet.Range("$A$1:$AH$68916").AutoFilter Field:=32, Criteria1:= _
"Blank"
Range("AG2").Select
ActiveCell.FormulaR1C1 = "FALSE"
Range("AG2").Select
Selection.FillDown
Range("AH2").Select
ActiveCell.FormulaR1C1 = "User Not part of approval rules"
Range("AH2").Select
Selection.FillDown
ActiveSheet.Range("$A$1:$AH$68916").AutoFilter Field:=32, Criteria1:="0"
Range("AG2447").Select
ActiveCell.FormulaR1C1 = "FALSE"
Range("AG2447").Select
Selection.FillDown
Range("AG2447:AG2448").Select
Selection.FillDown
Range("AH2447").Select
ActiveCell.FormulaR1C1 = "No approval Rules set up"
Selection.FillDown
Range("AH2447:AH2448").Select
ActiveCell.FormulaR1C1 = "No approval Rules set up"
Range("AH2448").Select
Selection.FillDown
ActiveSheet.Range("$A$1:$AH$68916").AutoFilter Field:=32, Criteria1:="2"
Range("AG306").Select
ActiveCell.FormulaR1C1 = "FALSE"
Selection.FillDown
Range("AG306").Select
Range(Selection, Selection.End(xlDown)).Select
ActiveWindow.SmallScroll Down:=18
Selection.FillDown
Range("AH306").Select
ActiveCell.FormulaR1C1 = "Multiple approvers required"
Selection.FillDown
Range("AH306").Select
Range(Selection, Selection.End(xlDown)).Select
ActiveWindow.SmallScroll Down:=21
Selection.FillDown
Range("AH306").Select
Range(Selection, Selection.End(xlDown)).Select
ActiveWindow.SmallScroll Down:=3
ActiveWindow.LargeScroll Down:=-4
ActiveWindow.ScrollRow = 68642
ActiveWindow.ScrollRow = 68370
ActiveWindow.ScrollRow = 61226
ActiveWindow.ScrollRow = 52001
ActiveWindow.ScrollRow = 1
ActiveSheet.Range("$A$1:$AH$68916").AutoFilter Field:=32, Criteria1:="1"
Range("AI808").Select
ActiveCell.FormulaR1C1 = _
"=IF(AND(R[-806]C[-27]=""-"",R[-806]C[-26]=""-"",R[-806]C[-25]=""-"",R[-806]C[-24]=""-"",R[-806]C[-23]=""-"",R[-806]C[-22]=""-"",R[-806]C[-21]=""-""),""FALSE"",""-"")"
Range("AI808").Select
Selection.FillDown
Range("AI808").Select
Range(Selection, Selection.End(xlDown)).Select
ActiveWindow.SmallScroll Down:=24
ActiveWindow.ScrollRow = 68799
ActiveWindow.ScrollRow = 67532
ActiveWindow.ScrollRow = 43181
ActiveWindow.ScrollRow = 1
Range("AI808").Select
ActiveCell.FormulaR1C1 = "=R[-806]C[-20]=R[-806]C[-19]"
Range("AI808").Select
Selection.FillDown
Range("AI808").Select
ActiveWindow.SmallScroll Down:=-12
ActiveCell.FormulaR1C1 = "=R[-806]C[-20]=R[-806]C[-19]"
Range("AI808").Select
Selection.FillDown
Range("AI808").Select
ActiveCell.FormulaR1C1 = "=R[-806]C[-20]=R[-806]C[-19]"
Range("AI808").Select
Selection.FillDown
Range("AI808").Select
Selection.FillDown
ActiveSheet.Range("$A$1:$AI$68916").AutoFilter Field:=35, Criteria1:="TRUE"
Range("AG808").Select
ActiveCell.FormulaR1C1 = "FALSE"
Range("AG808").Select
Selection.FillDown
Range("AG808").Select
Selection.FillDown
Range("AH808").Select
ActiveCell.FormulaR1C1 = "Segregation of user permissions"
Selection.FillDown
ActiveCell.FormulaR1C1 = "Segregation of user permissions"
Range("AH808").Select
Selection.FillDown
ActiveSheet.Range("$A$1:$AI$68916").AutoFilter Field:=35, Criteria1:= _
"FALSE"
Range("AG1093").Select
ActiveCell.FormulaR1C1 = "TRUE"
Range("AG1093").Select
Selection.FillDown
Range("AH1093").Select
ActiveCell.FormulaR1C1 = "No Segregation of user permissions"
Selection.FillDown
ActiveSheet.Range("$A$1:$AI$68916").AutoFilter Field:=35
Range("AI808").Select
ActiveCell.FormulaR1C1 = _
"=IF(AND(R[-806]C[-9]>=5000,R[-806]C[-8]>=5000),""FALSE"",""-"")"
Range("AI808").Select
Selection.FillDown
Range("AI808").Select
ActiveCell.FormulaR1C1 = _
"=IF(AND(R[-806]C[-9]>=5000,R[-806]C[-8]>=5000),""FALSE"",""-"")"
Range("AI808").Select
Selection.FillDown
Range("AI808").Select
ActiveWindow.SmallScroll Down:=-24
ActiveCell.FormulaR1C1 = _
"=IF(AND(R[-806]C[-9]<=5000,R[-806]C[-8]<=5000),""FALSE"",""-"")"
Range("AI808").Select
Selection.FillDown
Range("AI808").Select
ActiveCell.FormulaR1C1 = _
"=IF(AND(R[-806]C[-9]<=5000,R[-806]C[-8]<=5000),""FALSE"",""-"")"
Range("AI808").Select
Selection.FillDown
ActiveSheet.Range("$A$1:$AI$68916").AutoFilter Field:=35, Criteria1:= _
"FALSE"
Range("AG808").Select
ActiveCell.FormulaR1C1 = "FALSE"
Range("AG808").Select
Selection.FillDown
Range("AG808").Select
Range(Selection, Selection.End(xlDown)).Select
ActiveWindow.SmallScroll Down:=12
ActiveWindow.ScrollRow = 68303
ActiveWindow.ScrollRow = 67853
ActiveWindow.ScrollRow = 55181
ActiveWindow.ScrollRow = 1079
ActiveWindow.ScrollRow = 1
Range("AH808").Select
ActiveCell.FormulaR1C1 = "To amount less than $10,000"
Range("AH808").Select
Selection.FillDown
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlUp)).Select
ActiveWindow.ScrollRow = 68766
ActiveWindow.ScrollRow = 68042
ActiveWindow.ScrollRow = 56642
ActiveWindow.ScrollRow = 50036
ActiveWindow.ScrollRow = 996
ActiveWindow.ScrollRow = 1
ActiveSheet.Range("$A$1:$AI$68916").AutoFilter Field:=35
Selection.AutoFilter
Range("AG1").Select
Selection.AutoFilter
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 9
ActiveWindow.ScrollColumn = 10
ActiveWindow.ScrollColumn = 11
ActiveWindow.ScrollColumn = 12
ActiveWindow.ScrollColumn = 13
ActiveWindow.ScrollColumn = 14
ActiveWindow.ScrollColumn = 15
ActiveWindow.ScrollColumn = 16
ActiveWindow.ScrollColumn = 17
ActiveWindow.ScrollColumn = 18
ActiveWindow.ScrollColumn = 19
ActiveWindow.ScrollColumn = 20
End Sub}