Manipulate Raw Data Using Excel VBA [Project]

Note: This webpage is designed to accompany the Youtube video posted below. The video offers detailed explanation on all topics; while this webpage will serve as a repository for the code presented in the video.

Macro file can be downloaded from Github here.

Our task is to convert a raw, extract of Credit Card transactions into tabular format that is easy to lookup against.

The original data is not continuous i.e. it has blank rows. And data is grouped together by employee name and credit card. We need to disassemble these Transaction Groups.

The converted data will be continuous.

Below is the conversion logic.

Code

Option Explicit

Public Const sTopCell As String = "Date"
Public Const sBottomCell As String = "Total:"
Public Const sFirstColName As String = "Name"
Public Const sSecondColName As String = "Credit Card"

Sub AlignData()

wsOutput.Cells.Clear
Dim lrowIn As Long, lcolIn As Long
lrowIn = wsInput.UsedRange.Rows(wsInput.UsedRange.Rows.Count).Row
lcolIn = wsInput.UsedRange.Columns(wsInput.UsedRange.Columns.Count).Column

Dim sNameCC As String, sName As String, sCC As String
Dim sNameSplit() As String

Dim lFirstRow As Long, lLastRow As Long
Dim lFirstRowOut   As Long, lNextRowOut As Long
Dim i As Long, j As Long, x As Long

Dim lHeader As Boolean

For i = 1 To lrowIn
    If wsInput.Cells(i, 1).Value = sTopCell Then
        lFirstRow = i
        Else
        GoTo LineNext
    End If
    
    If lHeader = False Then
        wsOutput.Range("A1") = sFirstColName
        wsOutput.Range("B1") = sSecondColName
        wsInput.Range(wsInput.Cells(i, 1), wsInput.Cells(i, lcolIn)).Copy wsOutput.Range("C1")
        lHeader = True
    End If
    
    For j = lFirstRow To lrowIn
        If wsInput.Cells(j, 1).Value = sBottomCell Then
            lLastRow = j
            Exit For
        End If
    Next j
    
    If lLastRow = 0 Then
        MsgBox "Last cell not found after row " & lFirstRow
        Exit Sub
    End If
    
    If lLastRow - lFirstRow = 1 Then
        GoTo LineNext
    End If
    
    sNameCC = wsInput.Cells(lFirstRow - 1, 1).Value
    sNameSplit = Split(sNameCC, " - ")
    sName = sNameSplit(0)
    sCC = sNameSplit(1)
        
    lFirstRowOut = wsOutput.Cells(wsOutput.Rows.Count, "C").End(xlUp).Offset(1, 0).Row
    
    wsInput.Range(wsInput.Cells(lFirstRow + 1, 1), wsInput.Cells(lLastRow - 1, lcolIn)).Copy wsOutput.Range("C" & lFirstRowOut)
    
    lNextRowOut = wsOutput.Cells(wsOutput.Rows.Count, "C").End(xlUp).Row
    
    For x = lFirstRowOut To lNextRowOut
        wsOutput.Range("A" & x) = sName
        wsOutput.Range("B" & x) = sCC
    Next x
    
LineNext:
lFirstRow = 0
lLastRow = 0
sName = ""
sCC = ""
Next i

MsgBox "Done"
wsOutput.Activate

End Sub

Related Posts