VBA Excel - ways to store lists in VBA? - vba

Question

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!

Answer 1

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.

Answer 2

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.

Answer 3

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