MS Excel macro deleting duplicate rows and sum their values - excel

Question

I'm very briefly familiar with vba and I cannot work out how to amend the following script to make it do what I expect.
Basically I have 5 column excel. Column A are the values I would like to sum, providing that B and C and D and E are unique as a row.
I found the following script, which does nearly what I need:
Option Explicit
Sub RedoDataset()
Dim LastCol As Long
Dim LastRowData As Long
Dim LastRow As Long
Dim Ctr As Long
Dim CompanyArr
Dim RowFoundArr
Dim SumArr
Dim Rng As Range
Dim SettingsArray(1 To 2) As Integer
On Error Resume Next
With Application
SettingsArray(1) = .Calculation
SettingsArray(2) = .ErrorCheckingOptions.BackgroundChecking
.Calculation = xlCalculationManual
.EnableEvents = False
.ErrorCheckingOptions.BackgroundChecking = False
.ScreenUpdating = False
End With
On Error GoTo 0
With ThisWorkbook
With .Sheets("Sheet1")
LastRowData = .Cells(Rows.Count, 1).End(xlUp).Row
LastCol = .Cells(1, Columns.Count).End(xlToLeft).Column
Set Rng = .Range(.Cells(1, 1), .Cells(1, LastCol))
.Columns(2).AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=.Cells(1, LastCol + 2), Unique:=True
LastRow = .Cells(Rows.Count, LastCol + 2).End(xlUp).Row
ReDim CompanyArr(1 To LastRow - 1)
ReDim RowFoundArr(1 To LastRow - 1)
ReDim SumArr(1 To LastRow - 1)
For Ctr = 1 To LastRow - 1
CompanyArr(Ctr) = .Cells(Ctr + 1, LastCol + 2)
RowFoundArr(Ctr) = Application.Match(CompanyArr(Ctr), .Columns(2), 0)
SumArr(Ctr) = Application.SumIf(.Columns(2), CompanyArr(Ctr), .Columns(1))
.Cells(RowFoundArr(Ctr), 1) = SumArr(Ctr)
Set Rng = Union(Rng, .Range(.Cells(RowFoundArr(Ctr), 1), _
.Cells(RowFoundArr(Ctr), LastCol)))
Next Ctr
.Columns(LastCol + 2).Delete
For Ctr = LastRowData To 2 Step -1
If IsError(Application.Match(Ctr, RowFoundArr, 0)) Then
.Rows(Ctr).Delete
End If
Next Ctr
End With
End With
On Error Resume Next
With Application
.Calculation = SettingsArray(1)
.ErrorCheckingOptions.BackgroundChecking = SettingsArray(2)
.EnableEvents = True
.ScreenUpdating = True
.ScreenUpdating = True
End With
On Error GoTo 0
End Sub
this sums values of column A leaving column B unique. How do I extend this so not only B is unique, but condition is - B and C and D and E are unique in combination as a row.
Basically where the whole row is unique comparing to other, but not necessary each column contain only unique values:
A B C D E
1 0.01 La Ba foo boo
2 0.03 La boo foo Ba
3 0.12 La foo Ba boo
4 1.05 Ba La foo boo

Answer 1

Try this code - it uses a different approach, that's more flexible:
Const cStrDelimiter As String = ";"
Sub Aggregate()
Dim dic As Object
Dim rng As Range
Dim strCompound As String
Dim varKey As Variant
Set dic = CreateObject("Scripting.Dictionary")
'Store all unique combinations in a dictionary
Set rng = Worksheets("Sheet1").Range("A1")
While rng <> ""
strCompound = fctStrCompound(rng.Offset(, 1).Resize(, 4))
dic(strCompound) = dic(strCompound) + rng.Value
Set rng = rng.Offset(1)
Wend
'Save all unique, aggregated elements in worksheet
Set rng = Worksheets("Sheet1").Range("G1")
For Each varKey In dic.Keys
rng = dic(varKey)
rng.Offset(, 1).Resize(, 4).Cells = Split(varKey, cStrDelimiter)
Set rng = rng.Offset(1)
Next
End Sub
Private Function fctStrCompound(rngSource As Range) As String
Dim strTemp As String
Dim rng As Range
For Each rng In rngSource.Cells
strTemp = strTemp & rng.Value & cStrDelimiter
Next
fctStrCompound = Left(strTemp, Len(strTemp) - Len(cStrDelimiter))
End Function