Skip to content

Instantly share code, notes, and snippets.

@bhavin192
Last active July 24, 2021 12:06
Show Gist options
  • Select an option

  • Save bhavin192/de83bf9542f2dcc31d97cec794fce54e to your computer and use it in GitHub Desktop.

Select an option

Save bhavin192/de83bf9542f2dcc31d97cec794fce54e to your computer and use it in GitHub Desktop.
Attribute VB_Name = "MergeMacro"
Sub proc()
'Declaration
Dim tallySheet As Variant
Dim mergedSheet As Variant
Dim rowIndex As Integer
Dim columnIndex As Integer
Dim mergeDict As Variant
Dim keyFromRow As String
Dim currentRow As Variant
Dim mergeSheetRow As Integer
'Initialise the variables
Set tallySheet = Sheets(1)
Sheets.Add After:=tallySheet
ActiveSheet.Name = "MergedSheet"
Set mergedSheet = ActiveSheet
Set mergeDict = CreateObject("Scripting.Dictionary")
'Copy first 4 rows (Title etc.)
For mergeSheetRow = 1 To 4
tallySheet.Rows(mergeSheetRow).Copy
mergedSheet.Rows(mergeSheetRow).Insert Shift:=xlDown
Next mergeSheetRow
'Actual merging
For rowIndex = 5 To tallySheet.UsedRange.Rows.Count - 1
Set currentRow = tallySheet.Rows(rowIndex)
keyFromRow = currentRow.Cells(1, 2).Text
If mergeDict.Exists(keyFromRow) Then
For columnIndex = 5 To tallySheet.UsedRange.Columns.Count
mergeDict(keyFromRow).Cells(1, columnIndex).Value = mergeDict(keyFromRow).Cells(1, columnIndex).Value + currentRow.Cells(1, columnIndex).Value
Next columnIndex
Else
currentRow.Copy
mergedSheet.Rows(mergeSheetRow).Insert Shift:=xlDown
Set currentRow = mergedSheet.Rows(mergeSheetRow)
mergeSheetRow = mergeSheetRow + 1
mergeDict.Add Key:=keyFromRow, Item:=currentRow
End If
Next rowIndex
'Copy last row of Total
tallySheet.Rows(rowIndex).Copy
mergedSheet.Rows(mergeSheetRow).Insert Shift:=xlDown
MsgBox (mergeDict.Count)
'Clean dictionary
Set mergeDict = Nothing
End Sub
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment