Skip to content

Instantly share code, notes, and snippets.

Show Gist options
  • Star 1 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save sancarn/476d693f01265cd219145900df2aee47 to your computer and use it in GitHub Desktop.
Save sancarn/476d693f01265cd219145900df2aee47 to your computer and use it in GitHub Desktop.
'Example CSV:
' Column1,Column2,Result
' 1,2,
' 2,3,
' 3,5,
'Results in:
' Column1,Column2,Result
' 1,2,2
' 2,3,6
' 3,5,15
Public Sub TestMain()
'Get list object
Dim lo As ListObject: Set lo = ActiveSheet.ListObjects("Table1")
'Get data as collection of dicts
Dim cData As Collection: Set cData = getData(lo)
'Loop over data and perform calculations
Dim oRow As Object
For Each oRow In cData
oRow("Result") = oRow("Column1") * oRow("Column2")
Next
'Set new data
Call setData(lo, cData)
End Sub
'Obtain data from a list object as a collection of dictionary objects.
'@param {ListObject} The table to get the data from
'@param {Long=0} The field which contains the ID for each row. Returned collection will use this as a key. Ensure each row value is unique
'@returns {Collection} Table data represented as a collection of dictionaries.
Public Function getData(ByVal lo As ListObject, Optional ByVal keyCol As Long = 0) As Collection
Dim cRet As Collection: Set cRet = New Collection
Dim vData: vData = lo.Range.Value2
Dim ubRows As Long: ubRows = UBound(vData, 1)
Dim ubCols As Long: ubCols = UBound(vData, 2)
If keyCol <> 0 And (keyCol < 1 Or keyCol > ubCols) Then Err.Raise 1, "getData", "Param keyCol out of bounds in call to getData."
For i = 2 To ubRows
Dim oRow As Object: Set oRow = CreateObject("Scripting.Dictionary")
For j = 1 To ubCols
oRow(vData(1, j)) = vData(i, j)
Next
'Add to collection with KeyID or not
If keyCol <> 0 Then
cRet.Add oRow, CStr(vData(i, keyCol))
Else
cRet.Add oRow
End If
Next
Set getData = cRet
End Function
'Set table data from collection of dictionaries
'@param {ListObject} The table to set the data to
'@param {Collection<Dictioanry>} The collection of dictionaries you want to update the table to contain
Public Sub setData(ByVal lo As ListObject, ByVal col As Collection)
Dim vHeaders: vHeaders = lo.HeaderRowRange.Value2
Dim ubCols As Long: ubCols = UBound(vHeaders, 2)
Dim vData()
ReDim vData(1 To col.Count, 1 To ubCols)
Dim iRow As Long: iRow = 0
Dim oRow As Object
For Each oRow In col
iRow = iRow + 1
Dim jCol As Long
For jCol = 1 To ubCols
vData(iRow, jCol) = oRow(vHeaders(1, jCol))
Next
Next
lo.HeaderRowRange.Offset(1).Resize(col.Count).Value2 = vData
End Sub
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment