Sub AllSteps()
'Includes step 1 to 10
Dim x As String
Dim lr As Long
Dim i As Integer
Dim intRowCount As Integer
Dim ws As Worksheet
Dim fc As Worksheet
Dim r As Long
Dim lastrow As Long
Dim Dept As Range
Dim hds As Worksheet
'Create named range (Code at top of this module) ' ## Moved here to let Dept= line use named range as well
NamedRange
'Set ls = Worksheets("Department List")
'Set Dept = Sheets("Department List").Range("A1:B613") '## Replaced by next line
Set Dept = Range("Dept") 'Will work assuming Named Range exists
Application.StatusBar = "This macro may take a few minutes to run.... please wait"
Application.ScreenUpdating = False
'## This procedure assumes that you are starting with a particular worksheet active.
'## Either guarantee it with a select statement or (preferred) use a With...End With block
lr = Range("A" & Rows.Count).End(xlUp).Row
If Range("B2").Value <> "," Then '## to prevent deleting wrong rows
'Delete columns with commas in Step_1
Range("B1,D1,H1,J1").EntireColumn.Delete ' ## In the Ceredian sheet you posted after I pasted, columns B,D,I,K contained commas
' ## I modified the sheet I pasted to match this
'replace blanks with zeros Step_2
'Range("F1:F" & lr).Select '## Combined and replaced
'Selection.Replace What:="", Replacement:="0", LookAt:=xlWhole '## Combined and replaced
Range("F1:F" & lr).Replace What:="", Replacement:="0", LookAt:=xlWhole
'Range("F1").Select '## Not needed
'Columns("F:F").Select '## Combined and replaced
'Selection.NumberFormat = "#,##0.00" '## Combined and replaced
Columns("F:F").NumberFormat = "#,##0.00" '## Select as little as possible. Saves time
End If
'Replace all (235910,235920,237000,238000)account numbers with '219030,219035,219050,219070'
With Range("C1:C" & lr) '## With Block
.Replace What:="235910", Replacement:="219030", LookAt:=xlWhole
.Replace What:="235920", Replacement:="219035", LookAt:=xlWhole
.Replace What:="237000", Replacement:="219060", LookAt:=xlWhole
.Replace What:="238000", Replacement:="219070", LookAt:=xlWhole
End With
'Step_3, Step_4,
'Step_7, Step_8, Step_9 & Step_10 are combined within the 'Range("L" & i).Value = Range("D" & i).Value & etc... line
'Create_Balance_Sheet_Dept_01_0000_Step_3 & CopyDeptNames_ColumnJ_Step_4
'Formulas didnt trigger when tested, changed to vba
intRowCount = Range("A1").CurrentRegion.Rows.Count
For i = 1 To intRowCount
Select Case Range("C" & i).Value
Case 100000 To 299999
Range("I" & i).Value = "01-Oper:0000 Balance Sheet"
Range("J" & i).Value = "01-Oper:0000 Balance Sheet"
Range("L" & i).Value = Range("D" & i).Value & " " & Range("B" & i).Value
Range("M" & i).Value = Range("D" & i).Value & " " & Range("G" & i).Value & " " & Range("B" & i).Value
Case Else
Range("I" & i).Value = Range("E" & i).Value 'Changed from C to E
Range("J" & i).Value = Range("E" & i).Value 'Changed from C to E
Range("L" & i).Value = Range("D" & i).Value & " " & Range("B" & i).Value
Range("M" & i).Value = Range("D" & i).Value & " " & Range("G" & i).Value & " " & Range("B" & i).Value
End Select
Next i
'Format Column J Step_4
'Columns("J:J").Select '## Combined and replaced
'With Selection '## Combined and replaced
With Columns("J:J")
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
'Create VlookUp and hardcode values Step_5 & Step_6
' With Sheets("Ceridian File")
' lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
' With .Range("K1:K" & lastRow)
' .Formula = "=VLOOKUP(J1,Dept,2,0)"
' .Value = .Value
' End With
' End With
'Revised Step 5
With Sheets("Ceridian File")
.AutoFilterMode = False
lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
'CC
.Range("$A1:J" & lastrow).AutoFilter Field:=4, Criteria1:="CC" 'Entity Code
If Application.WorksheetFunction.Subtotal(3, .Columns(1)) > 1 Then
With .Range("K1:K" & lastrow).SpecialCells(xlCellTypeVisible)
.Formula = "=VLOOKUP(E1,Dept,2,0)"
'.Value = .Value 'Odd results when filter applied
End With
End If
'Schools & Parish (temporarily for Schools)
.Range("$A1:J" & lastrow).AutoFilter Field:=4, Criteria1:="<>CC" 'Entity Code
If Application.WorksheetFunction.Subtotal(3, .Columns(1)) > 1 Then
With .Range("K1:K" & lastrow).SpecialCells(xlCellTypeVisible)
.Formula = "=VLOOKUP(E1,Parish,2,0)"
'.Value = .Value 'Odd results when filter applied
End With
End If
'Schools (SA-SZ) (temporarily for SX-SZ))
.Range("$A1:J" & lastrow).AutoFilter Field:=4, Criteria1:="=S*" 'Entity Code
If Application.WorksheetFunction.Subtotal(3, .Columns(1)) > 1 Then
With .Range("K1:K" & lastrow).SpecialCells(xlCellTypeVisible)
.Formula = "=VLOOKUP(E1,Schools,2,0)"
'.Value = .Value 'Odd results when filter applied
End With
End If
'SX,SY,SZ back to Parish if required
.Range("$A1:J" & lastrow).AutoFilter Field:=4, Criteria1:= _
Array("SX", "SY", "SZ"), Operator:=xlFilterValues 'Entity Code
If Application.WorksheetFunction.Subtotal(3, .Columns(1)) > 1 Then
With .Range("K1:K" & lastrow).SpecialCells(xlCellTypeVisible)
.Formula = "=VLOOKUP(E1,Parish,2,0)"
'.Value = .Value 'Odd results when filter applied
End With
End If
.AutoFilterMode = False
With .Range("K1:K" & lastrow)
.Value = .Value
End With
End With
'Replace all (not found in list - #N/A) errors with 'Not Found'
'Range("K1:K" & lr).Select '## Combined and replaced
'Selection.Replace What:="#N/A", Replacement:="Not Found", LookAt:=xlWhole '## Combined and replaced
Range("K1:K" & lr).Replace What:="#N/A", Replacement:="Not Found", LookAt:=xlWhole
'Copy_Entity_Names_to__IIF_Conversion_Sheet_Col_B_Step_12
Range("D1:D" & lr).Copy Destination:=Sheets("IIF Conversion").Range("B1")
Range("B1:B" & lr).Copy Destination:=Sheets("IIF Conversion").Range("D1")
Range("C1:C" & lr).Copy Destination:=Sheets("IIF Conversion").Range("E1")
Range("K1:K" & lr).Copy Destination:=Sheets("IIF Conversion").Range("F1") 'Changed from I to K
Range("F1:F" & lr).Copy Destination:=Sheets("IIF Conversion").Range("G1")
Range("M1:M" & lr).Copy Destination:=Sheets("IIF Conversion").Range("I1")
'CreateIFFSpecialColumns_SPL_and_GENERAL_JOURNAL Step_13
With Sheets("IIF Conversion")
lastrow = .Cells(.Rows.Count, "B").End(xlUp).Row
With .Range("A1:A" & lastrow)
.Formula = "=IF(ISBLANK(A1),"""",""SPL"")"
.Value = .Value
End With
End With
With Sheets("IIF Conversion")
lastrow = .Cells(.Rows.Count, "B").End(xlUp).Row
With .Range("C1:C" & lastrow)
.Formula = "=IF(A1=""SPL"",""GENERAL JOURNAL"","""")"
.Value = .Value
End With
End With
'Call sort macro, need to look at this
'Call IIF_Final_Presort_Step_14
'IIF_Final_Format_Prior_To_Sort Macro Step_15
Sheets("IIF Conversion").Select
' Range("A1").Select '## Combined and replaced
' Selection.EntireRow.Insert '## Combined and replaced
' Selection.EntireRow.Insert '## Combined and replaced
' Selection.EntireRow.Insert '## Combined and replaced
Range("A1:C1").EntireRow.Insert
Set hds = ThisWorkbook.Sheets("Headers")
Set fc = ThisWorkbook.Sheets("IIF Conversion")
hds.Range("A1:I3").Copy fc.Range("A1")
'IIF_Conversion_Sheet_Data_Sort_Old_Procedure_Step_16A, no changes
'Call IIF_Conversion_Sheet_Data_Sort_Old_Procedure_Step_16A
'Format all new ws
Call FormatWS_rs2k
'Resize columns to fit data
Columns("A:M").EntireColumn.AutoFit
' Range("A1:J" & lr).Copy Destination:=Sheets("Working Sheet").Range("A1")
Application.ScreenUpdating = True
Application.StatusBar = False
End Sub
