Prepare Barclays CSV

prepare_csv.vba

Sub Prepare_CSV()
    '
    ' Prepare Barclays bank CSV export
    '
    ' - formats number, date and amount columns
    ' - splits memo column
    ' - trims resulting cells
    ' - consolidates amazon payees
    ' - copies data to clipboard
    '

    ' variables
    Dim ws As Worksheet
    Set ws = ActiveSheet

    Dim lastRow As Long
    lastRow = cells(Rows.Count, "A").End(xlUp).row - 1

    ' fit columns
    Columns.AutoFit

    ' format columns
    Columns("B:B").NumberFormat = "d mmm 'yy"
    Columns("D:D").NumberFormat = "$#,##0.00_);[Red]-$#,##0.00"
    
    ' align and trim numbers
    Dim numbers As Range
    Set numbers = Range("A1:A" & lastRow)
    numbers.HorizontalAlignment = xlLeft
    For Each cell In numbers
        If Not cell.HasFormula Then
            cell.value = Trim(cell.value)
        End If
    Next cell
        
    ' sort by date
    With ws.Sort
        .SortFields.Clear
        ' add the headers to sort
        .SortFields.Add _
            Key:=ws.Range("B1:B" & lastRow), _
            SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal

        ' set the sort range
        .SetRange ws.UsedRange
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

    ' split columns
    Range("F:F").TextToColumns _
        DataType:=xlFixedWidth, _
        FieldInfo:=Array(Array(0, 1), Array(22, 1)), _
        TrailingMinusNumbers:=True

    ' tidy up
    Columns("F:G").EntireColumn.AutoFit
    Range("G1").value = "Note"

    ' grab new cells
    Dim newCells As Range
    Set newCells = Range("F2", "G" & lastRow)

    ' trim split cells
    Application.ScreenUpdating = False
    For Each cell In newCells
        If cell.HasFormula = False Then
            cell.value = Trim(cell.value)
        End If
    Next cell
    Application.ScreenUpdating = True

    ' clean amazon cells
    For Each cell In Range("F2", "F" & lastRow)
        If Not cell.HasFormula Then
            Dim extractedName As String
            extractedName = ExtractName(cell.value, "Prime Video", "Amazon Prime", "Amazon.co.uk", "AMAZON*", "AMZ")
            If extractedName <> "" Then
                cell.value = extractedName
            End If
        End If
    Next cell

    ' select cells
    Dim allCells As Range
    Set allCells = Range("A2", "G" & lastRow)
    allCells.Select
    allCells.Copy
End Sub

Function ExtractName(cellValue As String, ParamArray keywords()) As String
    Dim keyword As Variant
    Dim found As Boolean
    found = False

    ' Check if the cell contains any of the keywords
    For Each keyword In keywords
        If InStr(1, cellValue, keyword, vbTextCompare) > 0 Then
            found = True
            Exit For
        End If
    Next keyword

    ' If a keyword is found, extract the part of the string before the "*"
    If found Then
        Dim asteriskPosition As Integer
        asteriskPosition = InStr(1, cellValue, "*")

        If asteriskPosition > 0 Then
            ExtractName = Trim(Left(cellValue, asteriskPosition - 1))
            Exit Function
        End If
    End If

End Function