CODEWITHSUNDEEP
vbaexceldata-structures
user4576226
user4576226

Reputation:

VBA Excel - ways to store lists in VBA?

I didn't know where else to turn, and I tried finding a question like mine but with no luck. I have a raw ranged table and I want to copy the info over into a new sheet, then convert that copied info into a ListObject table. I've worked out 99% of it, but then I wanted to change the raw headers of the copied table into my own headers (because most of the raw headers are very lengthy).

I built a loop to look at the [#Headers] cells, find values that matched a certain raw value, then replace it with my own value. E.g.

For Each cl In Range("Table1[#Headers]")
        If cl.Value = "Employee" Then
            cl.Value = "Name"
        ElseIf cl = "Employer Name" Then
            cl.Value = "Company"
'...
        End If
Next cl

Having a block of code that does this for 30+ instances is cumbersome, and if the raw information I receive somehow changes it's header values, I then have to hunt for this bit of code again and make the changes. I'm hoping there's a way to store a 2-columned list of before-and-after header names that any Sub can just reference, like a global Array (except global arrays are impossible). I looked into classes but again there are issues I'm having with globalizing the info.

I'm thinking about making a hidden worksheet with a 2-columned list but I'm really hoping that's not necessary, don't want any more sheets than I have to have. Is there a way to store lists for global use in Excel VBA?

Example image

SOLUTION:

Using @Mat's Mug advice, I'll show how I figured out how I added my Dictionary.

I made a public variant called DHeader and created a Sub to Call from:

Public DHeader As Dictionary

Sub Load_Headers()

If Not DHeader Is Nothing Then Exit Sub
Set DHeader = New Dictionary

With DHeader
    .add "Employee", "Name"
    .add "Employer Name", "Company"
    '...
End With

End Sub

Then within my action Sub I added this:

Call Load_Headers
For Each i_1 In Range("Table1[#Headers]")
    If DHeader.Exists(CStr(i_1.Value)) = True Then
        i_1.Value = DHeader.Item(CStr(i_1.Value))
    End If
Next i_1

Now my values and actions are separated into different parts of my code. I think I have to add a way to clear the dictionary in my action sub still, but it works!

Upvotes: 3

Views: 6854

Answers (3)

gembird
gembird

Reputation: 14053

Why not use the simple VBA Collection? No extra reference needed, no late binding needed, it is build directly into VBA.

Note: if the item is not found in the map, then the original raw header value is not replaced but it is simply skipped.

Option Explicit

Public Sub Main()
    Dim header As Range

    Set header = Worksheets("RawData").ListObjects("Table1").HeaderRowRange

    ReplaceInheaderRow headerRow:=header

    ' header contains transformed values now
End Sub

Private Function ReplaceInheaderRow(ByVal headerRow As Range) As Range
    Dim map As Collection
    Set map = New Collection

    map.Add "Name", "Employee"
    map.Add "Company", "Employer Name"
    map.Add "ID", "ID Numbers"
    map.Add "Income", "Wages"
    map.Add "etc.", "Some next column name"

    On Error Resume Next

    Dim rowHeaderCell As Range

    For Each rowHeaderCell In headerRow
        rowHeaderCell.Value = map(rowHeaderCell.Value)
    Next rowHeaderCell

    On Error GoTo 0
End Function

Upvotes: 2

David Zemens
David Zemens

Reputation: 53623

An alternative to dictionaries (although that might be be my preferred method, I would initialize them in a separate procedure) would be to split strings:

Sub DoStuff()
Const RawList As String = "Employee,Employer Name"
Const UpdateList as String = "Name,Employer"
Dim rawHeaders as Variant
Dim headers as Variant

rawHeaders = Split(RawList, ",")
headers = Split(UpdateList, ",")

    For Each cl In Range("Table1[#Headers]")
        If Not IsError(Application.Match(cl.Value, rawHeaders, False)) Then
            cl.Value = headers(Application.Match(cl.Value, rawHeaders, False))
        End If
    Next

End Sub

You can scope the arrays at the module level instead so they will be available for other procedure calls, etc.

Upvotes: 2

Mathieu Guindon
Mathieu Guindon

Reputation: 71197

No matter what you do, you're going to need to have the mappping code somewhere.

If a huge If-Then-Else block isn't very appealing, you can consider using a Dictionary object, from the Scripting library - using the "before" column name as your dictionary key, and the "after" column name as your dictionary value, the mapping code could look something like this:

Dim ColumnMap As New Scripting.Dictionary
With ColumnMap
    .Add "Employee", "Name"
    .Add "Employer Name", "Company"
    '...
End With

Then when you iterate the cells in the header row, you can verify that the name/key exists in your dictionary, and then proceed with the rename by fetching the mapped value. Just don't assume the column name exists in the dictionary, or you'll eventually run into "Key does not exist" runtime errors.

Upvotes: 3

Related Questions