Sub LoadCSV_FileTest4a()
Application.ScreenUpdating = False ' Turn ScreenUpdating off
'
Dim startTime As Single
Dim CSV_FileToOpen As Variant
'
CSV_FileToOpen = Application.GetOpenFilename("Text files,*.csv", , "Select file", , False) ' Save full path of CSV file to CSV_FileToOpen
If CSV_FileToOpen = False Then ' Exit Sub if user cancelled
MsgBox "No file selected - exiting"
Exit Sub
End If
'
startTime = Timer ' Start the stopwatch
'
Application.ScreenUpdating = False ' Turn ScreenUpdating off
'
Dim ArrayColumn As Long, ArrayRow As Long, NewArrayRow As Long
Dim CSV_ColumnMinus1 As Long, CSV_FileRow As Long
Dim FreeFileNumber As Long
Dim RowNumber As Long
Dim All_CSV_RowsFromCSV_FileArray As Variant, CSV_FileRowColumnsArray As Variant
Dim ShortenedCSV_FileArray As Variant, CSV_FinalArray As Variant
Dim Partitioned_CSV_FileArray As Variant
Dim wsDestination As Worksheet
'
Set wsDestination = Sheets("JohnnyL") ' <--- Set this to the sheet name to dump CSV_FinalArray
'
FreeFileNumber = FreeFile ' Get an unused file number
Open CSV_FileToOpen For Input As #FreeFileNumber
'
If Err.Number <> 0 Then ' If error occurred then ...
MsgBox "File open error #" & Err.Number & "!", vbCritical, "Error!" ' Display error #
Exit Sub ' Exit sub
End If
'
All_CSV_RowsFromCSV_FileArray = Split(Input(LOF(FreeFileNumber), #FreeFileNumber), vbCrLf) ' Load all Rows in file to All_CSV_RowsFromCSV_FileArray
Close #FreeFileNumber
'
RowNumber = 0 ' Initialize RowNumber
'
ReDim Partitioned_CSV_FileArray(1 To UBound(All_CSV_RowsFromCSV_FileArray), 1 To 100) ' Set rows/columns for Partitioned_CSV_FileArray
'
For CSV_FileRow = LBound(All_CSV_RowsFromCSV_FileArray) To UBound(All_CSV_RowsFromCSV_FileArray) ' Loop through all rows of CSV file
If All_CSV_RowsFromCSV_FileArray(CSV_FileRow) <> vbNullString Then ' If CSV row is not blank then ...
CSV_FileRowColumnsArray = Split(All_CSV_RowsFromCSV_FileArray(CSV_FileRow), ",") ' Load contents of row to CSV_FileRowColumnsArray
'
RowNumber = RowNumber + 1 ' Increment RowNumber
'
For CSV_ColumnMinus1 = LBound(CSV_FileRowColumnsArray) To UBound(CSV_FileRowColumnsArray) ' Loop through columns
Partitioned_CSV_FileArray(RowNumber, CSV_ColumnMinus1 + 1) = _
CSV_FileRowColumnsArray(CSV_ColumnMinus1) ' Add values to Partitioned_CSV_FileArray
Next ' Loop back
End If
Next ' Loop back
'
'' Sheets("Sheet2").Range("A1").Resize(UBound(Partitioned_CSV_FileArray, 1), UBound(Partitioned_CSV_FileArray, 2)) = Partitioned_CSV_FileArray
'
ReDim ShortenedCSV_FileArray(1 To UBound(Partitioned_CSV_FileArray, 1), 1 To 18) ' Set the row #s and # of columns for ShortenedCSV_FileArray
'
NewArrayRow = 0 ' Initialize NewArrayRow
'
For ArrayRow = 1 To UBound(Partitioned_CSV_FileArray, 1) ' Loop through all the rows of the Partitioned_CSV_FileArray
If IsDate(Partitioned_CSV_FileArray(ArrayRow, 2)) Or _
IsDate(Partitioned_CSV_FileArray(ArrayRow, 3)) Or _
IsDate(Partitioned_CSV_FileArray(ArrayRow, 10)) Then ' If Date found in Column 2, 3, or 10 then ...
NewArrayRow = NewArrayRow + 1 ' Increment NewArrayRow
'
For ArrayColumn = 1 To UBound(Partitioned_CSV_FileArray, 2) ' Loop through all columns of the Partitioned_CSV_FileArray
Select Case ArrayColumn ' Save the needed data into ShortenedCSV_FileArray ...
Case 1 To 3
ShortenedCSV_FileArray(NewArrayRow, ArrayColumn) = Partitioned_CSV_FileArray(ArrayRow, ArrayColumn)
Case 6
ShortenedCSV_FileArray(NewArrayRow, 4) = Partitioned_CSV_FileArray(ArrayRow, ArrayColumn)
Case 8
ShortenedCSV_FileArray(NewArrayRow, 5) = Partitioned_CSV_FileArray(ArrayRow, ArrayColumn)
Case 10
ShortenedCSV_FileArray(NewArrayRow, 6) = Partitioned_CSV_FileArray(ArrayRow, ArrayColumn)
Case 13
ShortenedCSV_FileArray(NewArrayRow, 7) = Partitioned_CSV_FileArray(ArrayRow, ArrayColumn)
Case 16
ShortenedCSV_FileArray(NewArrayRow, 8) = Partitioned_CSV_FileArray(ArrayRow, ArrayColumn)
Case 17
ShortenedCSV_FileArray(NewArrayRow, 9) = Partitioned_CSV_FileArray(ArrayRow, ArrayColumn)
Case 18
ShortenedCSV_FileArray(NewArrayRow, 10) = Partitioned_CSV_FileArray(ArrayRow, ArrayColumn)
Case 19
ShortenedCSV_FileArray(NewArrayRow, 11) = Partitioned_CSV_FileArray(ArrayRow, ArrayColumn)
Case 30
ShortenedCSV_FileArray(NewArrayRow, 12) = Partitioned_CSV_FileArray(ArrayRow, ArrayColumn)
Case 33
ShortenedCSV_FileArray(NewArrayRow, 13) = Partitioned_CSV_FileArray(ArrayRow, ArrayColumn)
Case 34
ShortenedCSV_FileArray(NewArrayRow, 14) = Partitioned_CSV_FileArray(ArrayRow, ArrayColumn)
'
Case 35
ShortenedCSV_FileArray(NewArrayRow, 15) = Partitioned_CSV_FileArray(ArrayRow, ArrayColumn)
'
Case 38
ShortenedCSV_FileArray(NewArrayRow, 16) = Partitioned_CSV_FileArray(ArrayRow, ArrayColumn)
Case 40
ShortenedCSV_FileArray(NewArrayRow, 17) = Partitioned_CSV_FileArray(ArrayRow, ArrayColumn)
Case 41
ShortenedCSV_FileArray(NewArrayRow, 18) = Partitioned_CSV_FileArray(ArrayRow, ArrayColumn)
End Select
Next ' Loop back
End If
Next ' Loop back
'
'' Sheets("Sheet3").Range("A1").Resize(UBound(ShortenedCSV_FileArray, 1), UBound(ShortenedCSV_FileArray, 2)) = ShortenedCSV_FileArray
'
Debug.Print NewArrayRow & " Rows of data processed from the CSV file." ' Display the # of data lines that were processed to the 'Immediate Window'(CTRL-G)
'
ReDim CSV_FinalArray(1 To NewArrayRow, 1 To 5) ' Set the # of rows & columns for the CSV_FinalArray
'
For ArrayRow = 1 To UBound(CSV_FinalArray, 1) ' Loop through all the rows of the CSV_FinalArray
If ShortenedCSV_FileArray(ArrayRow, 3) = vbNullString Then ' If column 3 = blank then ...
CSV_FinalArray(ArrayRow, 1) = ShortenedCSV_FileArray(ArrayRow, 6) ' Save Column 6 of ShortenedCSV_FileArray to CSV_FinalArray
CSV_FinalArray(ArrayRow, 2) = Replace(Replace(ShortenedCSV_FileArray(ArrayRow, 9), Chr(10), ""), """", "") & _
" Txn No." & ShortenedCSV_FileArray(ArrayRow, 1) ' Delete Line Feeds, quotations, append Txn #s as needed
If ShortenedCSV_FileArray(ArrayRow, 5) <> vbNullString And ShortenedCSV_FileArray(ArrayRow, 5) <> "-" Then
CSV_FinalArray(ArrayRow, 2) = CSV_FinalArray(ArrayRow, 2) & " Branch Name - " & _
Replace(ShortenedCSV_FileArray(ArrayRow, 5), Chr(10), "") ' Append Branch Name if needed
End If
'
If ShortenedCSV_FileArray(ArrayRow, 7) <> vbNullString Then
CSV_FinalArray(ArrayRow, 2) = CSV_FinalArray(ArrayRow, 2) & " Cheque No. " & _
ShortenedCSV_FileArray(ArrayRow, 7) ' Append Cheque # if needed
End If
'
If ShortenedCSV_FileArray(ArrayRow, 15) <> vbNullString Then
CSV_FinalArray(ArrayRow, 2) = CSV_FinalArray(ArrayRow, 2) & " Cheque No. " & _
ShortenedCSV_FileArray(ArrayRow, 15) ' Append Cheque # if needed
End If
'
CSV_FinalArray(ArrayRow, 4) = ShortenedCSV_FileArray(ArrayRow, 16) ' Save Column 15 of ShortenedCSV_FileArray to CSV_FinalArray
CSV_FinalArray(ArrayRow, 5) = ShortenedCSV_FileArray(ArrayRow, 17) ' Save Column 16 of ShortenedCSV_FileArray to CSV_FinalArray
'
If CSV_FinalArray(ArrayRow, 4) <> vbNullString Then CSV_FinalArray(ArrayRow, 3) = "Payment" ' If column 4 is not blank then set "Payment"
If CSV_FinalArray(ArrayRow, 5) <> vbNullString Then CSV_FinalArray(ArrayRow, 3) = "Receipt" ' If column 5 is not blank then set "Receipt"
'
ElseIf ShortenedCSV_FileArray(ArrayRow, 2) <> vbNullString Then ' If column 2 = blank then ...
CSV_FinalArray(ArrayRow, 1) = ShortenedCSV_FileArray(ArrayRow, 2) ' Save Column 2 of ShortenedCSV_FileArray to CSV_FinalArray
CSV_FinalArray(ArrayRow, 2) = Replace(Replace(ShortenedCSV_FileArray(ArrayRow, 3), Chr(10), ""), """", "") & _
" Txn No." & ShortenedCSV_FileArray(ArrayRow, 1) ' Delete Line Feeds, quotations, append Txn #s as needed
'
If ShortenedCSV_FileArray(ArrayRow, 5) <> vbNullString And ShortenedCSV_FileArray(ArrayRow, 5) <> "-" Then
CSV_FinalArray(ArrayRow, 2) = CSV_FinalArray(ArrayRow, 2) & " Branch Name - " & _
Mid(Replace(ShortenedCSV_FileArray(ArrayRow, 5), Chr(10), ""), 2, Len(Replace(ShortenedCSV_FileArray(ArrayRow, 5), Chr(10), "")) - 2) ' Append Branch Name if needed
End If
'
If ShortenedCSV_FileArray(ArrayRow, 7) <> vbNullString Then
CSV_FinalArray(ArrayRow, 2) = CSV_FinalArray(ArrayRow, 2) & " Cheque No. " & _
ShortenedCSV_FileArray(ArrayRow, 7) ' Append Cheque # if needed
End If
'
CSV_FinalArray(ArrayRow, 4) = ShortenedCSV_FileArray(ArrayRow, 8) ' Save Column 8 of ShortenedCSV_FileArray to CSV_FinalArray
CSV_FinalArray(ArrayRow, 5) = ShortenedCSV_FileArray(ArrayRow, 10) ' Save Column 10 of ShortenedCSV_FileArray to CSV_FinalArray
'
If CSV_FinalArray(ArrayRow, 4) <> vbNullString Then CSV_FinalArray(ArrayRow, 3) = "Payment" ' If column 4 is not blank then set "Payment"
If CSV_FinalArray(ArrayRow, 5) <> vbNullString Then CSV_FinalArray(ArrayRow, 3) = "Receipt" ' If column 5 is not blank then set "Receipt"
'
Else
CSV_FinalArray(ArrayRow, 1) = ShortenedCSV_FileArray(ArrayRow, 3)
CSV_FinalArray(ArrayRow, 2) = Replace(Replace(ShortenedCSV_FileArray(ArrayRow, 4), Chr(10), ""), """", "") & _
" Txn No." & ShortenedCSV_FileArray(ArrayRow, 1) ' Delete Line Feeds, quotations, append Txn #s as needed
'
If ShortenedCSV_FileArray(ArrayRow, 5) <> vbNullString And ShortenedCSV_FileArray(ArrayRow, 5) <> "-" Then
CSV_FinalArray(ArrayRow, 2) = CSV_FinalArray(ArrayRow, 2) & " Branch Name - " & _
Replace(ShortenedCSV_FileArray(ArrayRow, 5), Chr(10), "") ' Append Branch Name if needed
End If
'
If ShortenedCSV_FileArray(ArrayRow, 7) <> vbNullString Then
CSV_FinalArray(ArrayRow, 2) = CSV_FinalArray(ArrayRow, 2) & " Cheque No. " & _
ShortenedCSV_FileArray(ArrayRow, 7) ' Append Cheque # if needed
End If
'
CSV_FinalArray(ArrayRow, 4) = ShortenedCSV_FileArray(ArrayRow, 12) ' Save Column 12 of ShortenedCSV_FileArray to CSV_FinalArray
CSV_FinalArray(ArrayRow, 5) = ShortenedCSV_FileArray(ArrayRow, 13) ' Save Column 13 of ShortenedCSV_FileArray to CSV_FinalArray
'
If CSV_FinalArray(ArrayRow, 4) <> vbNullString Then CSV_FinalArray(ArrayRow, 3) = "Payment" ' If column D is not blank then "Payment"
If CSV_FinalArray(ArrayRow, 5) <> vbNullString Then CSV_FinalArray(ArrayRow, 3) = "Receipt" ' If column E is not blank then "Receipt"
End If
Next
'
wsDestination.UsedRange.Clear ' Clear the destination sheet
wsDestination.Range("A1:E1").Value = Array("Txn Date", "Description", "Voucher Type", "Dr Amount", "Cr Amount") ' Add header row to sheet
'
wsDestination.Columns("A:A").NumberFormat = "@" ' Set column to text so Excel don't mess up dates
'
wsDestination.Range("A2").Resize(UBound(CSV_FinalArray, 1), UBound(CSV_FinalArray, 2)).Value = CSV_FinalArray ' Display CSV_FinalArray to sheet
'
wsDestination.Range("E2").CurrentRegion.Sort key1:=wsDestination.Range("E2"), order1:=xlAscending, Header:=xlGuess ' Sort columns by the E column
wsDestination.Range("D2").CurrentRegion.Sort key1:=wsDestination.Range("D2"), order1:=xlAscending, Header:=xlGuess ' Sort columns by the D column
wsDestination.Range("A2").CurrentRegion.Sort key1:=wsDestination.Range("A2"), order1:=xlAscending, Header:=xlGuess ' Sort columns by the A Column
'
wsDestination.Columns("D:E").NumberFormat = "0.00" ' Format Columns D:E to two decimal places
wsDestination.UsedRange.EntireColumn.AutoFit ' Autofit used columns
'
Application.Goto wsDestination.Range("A1") ' Go to result sheet
'
Application.ScreenUpdating = False ' Turn ScreenUpdating back on
'
Debug.Print "Time to complete = " & Timer - startTime & " seconds." ' about .05 seconds
End Sub