Wim‘s Excel, TM1 & soccer site

From raw data to analysis

Sep. 10, 2021

Introduction

It's been a while since a new article was published on my website, but today there is one. What I do literally every day, is reconciling/analysing data, etc. Oftentimes I start with a dump or export of raw data in Excel whereby I will want to filter, sort or apply other transformations. The same sequence of steps is always coming back:

paste the raw data in Excel
add a title row
apply the autofilter
apply good column widths that fit the data
apply freeze panes
potentially add a pivot table
etc.

I was doing all these steps manually, until now ! I wrote a macro to automate the above steps (except step 1 but I could do that too). We paste the data:

and the macro will convert it to:

The code

Sub Prepare_Range_For_Analysis()

    Dim r                     As Range
    Dim tbl                   As ListObject
    Dim rngToEvaluate         As Range
    Dim rngTitleRow           As Range
    Dim wsActiveSheet         As Worksheet
    Dim i                     As Long
    Dim sAdd_Header           As String
    Dim bAdd_Header           As Boolean

    Set wsActiveSheet = ActiveSheet

    If TypeName(Selection) <> "Range" Then
        MsgBox "Select a cell in a range first."
        GoTo einde
    End If

    Set r = Selection

    Application.ScreenUpdating = False

    Set tbl = r.ListObject
    If Not tbl Is Nothing Then

        MsgBox "Real Excel tables have less advantages with this macro.", vbInformation
        Exit Sub

    End If

    Set rngToEvaluate = Nothing
    On Error Resume Next
    Set rngToEvaluate = wsActiveSheet.AutoFilter.Range
    On Error GoTo 0

    If rngToEvaluate Is Nothing Then

        'there is no Autofilter in the active sheet
        Set rngToEvaluate = r.CurrentRegion

    Else

        MsgBox "Please turn off the autofilter in the sheet.", vbInformation
        Exit Sub

    End If

    On Error Resume Next
    sAdd_Header = LCase(Left(Application.Trim(InputBox("Do you want to add a header row ?", "Header row", "Y")), 1))
    On Error GoTo 0

    If Trim(sAdd_Header) = "" Then
        MsgBox "Please enter a choice.", vbInformation
        Exit Sub
    End If

    bAdd_Header = (sAdd_Header = "y")
    If bAdd_Header Then

        If rngToEvaluate.Row = 1 Then
            wsActiveSheet.Rows(rngToEvaluate.Row).Insert
        End If

        Set rngTitleRow = rngToEvaluate.Rows(1).Offset(-1)
        For i = 1 To rngTitleRow.Cells.count
            If WorksheetFunction.CountIf(rngToEvaluate.Columns(i), "Actual") > 0 Or _
               WorksheetFunction.CountIf(rngToEvaluate.Columns(i), "Budget") > 0 Then

                rngTitleRow.Cells(1, i).value = "Scenario"

            ElseIf WorksheetFunction.CountIf(rngToEvaluate.Columns(i), "FIN") > 0 Or _
                   WorksheetFunction.CountIf(rngToEvaluate.Columns(i), "WRK") > 0 Then

                rngTitleRow.Cells(1, i).value = "Version"

            ElseIf WorksheetFunction.CountIf(rngToEvaluate.Columns(i), "EUR") > 0 Or _
                   WorksheetFunction.CountIf(rngToEvaluate.Columns(i), "USD") > 0 Or _
                   WorksheetFunction.CountIf(rngToEvaluate.Columns(i), "GBP") > 0 Or _
                   WorksheetFunction.CountIf(rngToEvaluate.Columns(i), "PLN") > 0 Then

                rngTitleRow.Cells(1, i).value = "Currency"

            ElseIf WorksheetFunction.CountIf(rngToEvaluate.Columns(i), "LC") > 0 Or _
                   WorksheetFunction.CountIf(rngToEvaluate.Columns(i), "GC") > 0 Or _
                   WorksheetFunction.CountIf(rngToEvaluate.Columns(i), "LOC") > 0 Or _
                   WorksheetFunction.CountIf(rngToEvaluate.Columns(i), "GRP") > 0 Or _
                   WorksheetFunction.CountIf(rngToEvaluate.Columns(i), "Local Currency") > 0 Or _
                   WorksheetFunction.CountIf(rngToEvaluate.Columns(i), "Group Currency") > 0 Then

                rngTitleRow.Cells(1, i).value = "Currency_Type"

            ElseIf WorksheetFunction.Min(rngToEvaluate.Columns(i)) = 1950 And _
                   WorksheetFunction.max(rngToEvaluate.Columns(i)) = 2050 Then

                rngTitleRow.Cells(1, i).value = "Year"

            ElseIf WorksheetFunction.Min(rngToEvaluate.Columns(i)) >= 1 And _
                   WorksheetFunction.max(rngToEvaluate.Columns(i)) <= 12 Then

                rngTitleRow.Cells(1, i).value = "Month"

            Else
                rngTitleRow.Cells(1, i).value = Split(wsActiveSheet.Cells(, i).Address, "$")(1)
            End If
        Next
    Else
        Set rngTitleRow = rngToEvaluate.Rows(1)
    End If

    'rngTitleRow.Font.Bold = True

    On Error Resume Next
    rngTitleRow.Style = "Kop 2"
    rngTitleRow.Style = "Heading 2"
    On Error GoTo 0
    rngTitleRow.HorizontalAlignment = xlCenter

    With ActiveWindow
        .SplitColumn = rngTitleRow.Column - .ScrollColumn + 1
        .SplitRow = rngTitleRow.Row - .ScrollRow + 1
        .FreezePanes = True
    End With

    rngTitleRow.AutoFilter

    'column widths, with a given max width
    rngToEvaluate.EntireColumn.AutoFit
    For i = 1 To rngTitleRow.Cells.count
        rngToEvaluate.Columns(i).ColumnWidth = Application.Min(50, rngToEvaluate.Columns(i).ColumnWidth)
    Next

    Application.Goto rngTitleRow.Cells(1), True

    If MsgBox("Would you like to create a pivot table based on it ?", vbYesNo) = vbYes Then
        RangeToPivot control
    End If

einde:
    Application.ScreenUpdating = True

End Sub

The code asks whether the user wants to add a header row. In case the data already starts at row 1, a new row will be inserted. If not, the code will add the headers in the cells above the table. If we indeed request a header row, then it will be populated with letters: A for the first column of the data, B for the first column of the data, etc. It is allowed that the data only start in let's say cell D20. Freeze panes will be applied as well, and the columns will autofit the data (but not wider that than 50 pixels).

What is important to me, is that certain columns can be recognized. In my day to day job I work with scenarios, versions, years, months, currencies, currency types, customers, products, accounts, cost centers, ... Who knows you can use similar code. Finally the code will ask if you want to add a pivot table out of the data (again with time saving options). You will not have that macro, but feel free to let it inspire you.

wimgielis.com

Excel, TM1 and soccer

From raw data to analysis

Introduction

The code

Homepage

Section contents

About Wim

Other links