Option Explicit
Sub FixCSV()
Dim wbCSV As Workbook, wb As Workbook
Dim wsCSV As Worksheet
Dim rCSV As Range, rCSV1 As Range, rStore As Range
Dim i As Long, j As Long
'find open WB ending in CSV
For Each wb In Workbooks
If Right(wb.FullName, 3) = "CSV" Then
Set wbCSV = wb
Exit For
End If
Next
If wbCSV Is Nothing Then
Call MsgBox("There is no CSV file open in Excel", vbExclamation + vbOKOnly, "Fix CSV")
Exit Sub
End If
Application.ScreenUpdating = False
Set wsCSV = wbCSV.Worksheets(1)
With wsCSV ' Guessing
.Cells(1, 1).Value = "Date"
.Cells(1, 2).Value = "Invoice"
.Cells(1, 3).Value = "Store"
.Cells(1, 4).Value = "Product"
.Cells(1, 5).Value = "Qty"
.Cells(1, 6).Value = "Cost"
.Cells(1, 7).Value = "InvCred"
.Cells(1, 8).Value = "Something"
.Cells(1, 9).Value = "Counter1"
.Cells(1, 10).Value = "Counter2"
.Cells(1, 11).Value = "Counter3"
.Cells(1, 12).Value = "Representitive"
'delete stores
Call .Columns(3).Replace(" STALE", "", xlPart) ' PHH 12/29/2020
On Error Resume Next
For Each rStore In ThisWorkbook.Worksheets("DeleteStores").Cells(1, 1).CurrentRegion
Call .Columns(3).Replace(rStore.Value, True, xlWhole)
Next
.Columns(3).SpecialCells(xlCellTypeConstants, xlLogical).EntireRow.Delete
Call .Columns(5).Replace(0, True, xlWhole) ' PHH 12/29/2020
.Columns(5).SpecialCells(xlCellTypeConstants, xlLogical).EntireRow.Delete ' PHH 12/29/2020
On Error GoTo 0
Set rCSV = .Cells(1, 1).CurrentRegion
'save original order
For i = 1 To rCSV.Rows.Count
.Cells(i, 13).Value = i
Next i
Set rCSV = .Cells(1, 1).CurrentRegion
Set rCSV1 = rCSV.Cells(2, 1).Resize(rCSV.Rows.Count - 1, rCSV.Columns.Count)
With .Sort
.SortFields.Clear
.SortFields.Add Key:=rCSV1.Columns(1), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SortFields.Add Key:=rCSV1.Columns(3), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SortFields.Add Key:=rCSV1.Columns(7), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
.SetRange rCSV
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End With
With rCSV
For i = 2 To .Rows.Count
If .Cells(i, 7).Value = "C" Then ' CREDIT?
j = i
'same store and same date
Do While (.Cells(j, 3).Value = .Cells(i - 1, 3).Value) And _
(.Cells(j, 1).Value = .Cells(i - 1, 1).Value)
.Cells(j, 2).Value = "9" & .Cells(i - 1, 2).Value ' add leading 9
.Cells(j, 12).Value = .Cells(i - 1, 12).Value ' add rep
.Cells(j, 7).Value = "-C" ' add marker
j = j + 1
Loop
End If
Next i
Call .Columns(7).Replace("-C", "C", xlWhole)
End With
'back to original sort order
With wsCSV
With .Sort
.SortFields.Clear
.SortFields.Add Key:=rCSV1.Columns(13), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SetRange rCSV
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'get rid of order column
.Columns(13).Delete
'row 1 was originally blank
.Rows(1).Resize(1, 12).ClearContents
End With
Application.ScreenUpdating = False
MsgBox "CSV file " & wbCSV.FullName & " reformatted"
End Sub