Option Explicit
' ----------------------------------------------------------------
' Procedure Name: ProcessResults
' Purpose: Summarize items and quantities then export to a csv file.
' Procedure Kind: Sub
' Procedure Access: Public
' Author: Jim
' Date: 7/2/2023
' ----------------------------------------------------------------
Sub ProcessResults()
' Worksheet containing the data to export.
Dim wsData As Worksheet
' Cell that is the "Anchor" for the data to process.
Dim rAnchorCellData As Range
' Cell that is the "Anchor" for the results.
Dim rAnchorCellResults As Range
' Used to iterate through data.
Dim rCell As Range
' Contains the name of the file to save
Dim sFileNameLabel As String
' Contains the name of the csv file.
Dim sFileName As String
' Contains the label for the data range.
Dim sDataLabel As String
' Contains the label for the results range.
Dim sResultsLabel As String
' Used with dictionary to keep track of each item.
Dim sItemName As String
' Used with dictionary to keep track of items' quantity.
Dim iItemNextQuantity As Long
Dim iItemExistingQuantity As Long
' Count of rows of results
Dim iResultsRowsCount As Long
' Used to keep track of count of rows processed within Do Loop.
Dim iDataRow As Long
' Used to iterate through all entries in the dictionary
Dim vKey As Variant
' Create dictionary
Dim dicData As Object
Set dicData = CreateObject("Scripting.Dictionary")
' Code looks for this word to know where the file name is located.
sFileNameLabel = "File Name"
' Code looks for this word to know where the data starts.
sDataLabel = "Data"
' Code looks for this word to know where the results start.
sResultsLabel = "Results"
Set wsData = ActiveSheet
' Look for cell that is the row header label for the file name.
Set rCell = FindCell(wsData, sFileNameLabel)
If rCell Is Nothing _
Then
MsgBox "Could not find the label cell for the file name (" & sFileNameLabel & ").", vbInformation
Exit Sub
Else
' File name is in the cell one tho the right of the cell where the file name label is found.
sFileName = rCell.Offset(0, 1).Value
End If
'sFileNameLabel
' Get anchor cell for data. It is two cells below the cell whose label is in sDataLabel.
Set rAnchorCellData = FindCell(wsData, sDataLabel)
If rAnchorCellData Is Nothing _
Then
MsgBox "Could not find the label cell for data (" & sDataLabel & ").", vbInformation
Exit Sub
End If
Set rAnchorCellData = rAnchorCellData.Cells.Offset(2)
' Get anchor cell for results. It is two cells below the cell whose label is in sResultsLabel.
Set rAnchorCellResults = FindCell(wsData, sResultsLabel)
If rAnchorCellResults Is Nothing _
Then
MsgBox "Could not find the label cell for results (" & sResultsLabel & ").", vbInformation
Exit Sub
End If
Set rAnchorCellResults = rAnchorCellResults.Cells.Offset(2)
' Get count of DATA rows in the results range. Minus one to skip headers.
iResultsRowsCount = rAnchorCellResults.CurrentRegion.Rows.Count - 1
' Clear the existing results
If iResultsRowsCount <> 0 _
Then rAnchorCellResults.Offset(1).Resize(iResultsRowsCount, 2).Clear
With rAnchorCellData
iDataRow = 0
Do
sItemName = .Offset(iDataRow + 1, 0).Value
iItemNextQuantity = .Offset(iDataRow + 1, 1).Value
If Not dicData.Exists(sItemName) _
Then
' The item IS NOT in the dictionary so add it, with quantity.
dicData.Add sItemName, iItemNextQuantity
Else
' Item IS in the dictionary. Get the existing value, add it to the
' next quantity then put updated values into the dictinary.
iItemExistingQuantity = dicData(sItemName)
iItemNextQuantity = iItemNextQuantity + iItemExistingQuantity
dicData(sItemName) = iItemNextQuantity
End If
iDataRow = iDataRow + 1
Loop Until .Offset(iDataRow + 1) = ""
End With
iDataRow = 0
' Put results into the result area in the worksheet.
With rAnchorCellResults
For Each vKey In dicData.Keys
iDataRow = iDataRow + 1
With .Offset(iDataRow, 0)
.Value = vKey
End With
With .Offset(iDataRow, 1)
.Value = dicData(vKey)
End With
Next vKey
End With
' Create the csv file
Call ExportRangeToCSVFile(rAnchorCellResults.CurrentRegion, sFileName)
End Sub
