Sub Access_input()
Dim iLast_Row As Integer, iSplit As Integer
iSplit = 0
'
' Access_input Macro
' Macro recorded 17/02/2011 by Paul Steel
'
' Keyboard Shortcut: Ctrl+i
'
' Check if we have splits or have not checked before running
iSplit = MsgBox("Any Splits to process", vbYesNoCancel)
If iSplit = 2 Then ' Cancel selected
Exit Sub
End If
' Find top BALANCE row and delete
ActiveSheet.Cells(1, 1).Select
Cells.Find(What:="BALANCE ", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
Range(ActiveCell.Row & ":" & ActiveCell.Row - 1).Select
Selection.Delete Shift:=xlUp
' Find TOTAL field, select extra rows and delete
Cells.Find(What:="TOTAL ", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
Range(ActiveCell.Row & ":" & ActiveCell.Row + 10).Select
Selection.Delete Shift:=xlUp
' Now format Amount column so no commas present
Columns("I:I").Select
Selection.NumberFormat = "0.00"
' Now remove empty column A
Columns("A:A").Select
Selection.Delete Shift:=xlToLeft
' Now format for splits if they exist
If iSplit = 6 Then ' Yes was selected
Fill_Split
End If
' Sort by date
Cells.Select
Range("H91").Activate
Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
'Now format the date column
Columns("A:A").Select
Selection.NumberFormat = "m/d/yyyy"
' Make sure the Payee/Cheque number have no decimal places and trim the width
Columns("C:C").Select
Selection.NumberFormat = "0"
Columns("C:C").ColumnWidth = 10
' And finally move the heading to the top
' iLast_Row = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
' Range("A" & iLast_Row & ":Z" & iLast_Row).Select
' Selection.Cut
' Rows("1:1").Select
' Selection.Insert Shift:=xlDown
Range("A1").Value = "Transactiondate"
' Finally save the file
Application.DisplayAlerts = False
ChDir "C:\Users\PAUL\Documents\SSAFA"
ActiveWorkbook.SaveAs Filename:= _
"C:\Users\PAUL\Documents\SSAFA\Access Input.xls", FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
Application.DisplayAlerts = True
End Sub
Sub Fill_Split()
Dim Last_Row As Long
' Find last Row for loop
Last_Row = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
' Now copy the data to rows left by the split function of Quicken
Range("A1").Select
Do While ActiveCell.Row < Last_Row
Columns("A:A").Select
Selection.Find(What:="", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
Call Move_Cursor("Up")
Range("A" & ActiveCell.Row & ":E" & ActiveCell.Row).Select
Selection.Copy
Range("A" & ActiveCell.Row + 1).Select
ActiveSheet.Paste
Loop
End Sub
