I've looked and test for this since 48 hours and couldn't find the right solution (or correctly adapt an existing one).
Attached is a screenshot of my Excel. Basically, I want to say (in a function or VBA script): WHEN "ICCID" (column B) is the same THEN merge lines by concatenate "Country" (column M) AND sum-up values in columns O, P, and Q. (and of course remove the lines which were merged)
Does anyone have a fix for this? Thank you very much in advance
CodePudding user response:
Please, try the next code. It places in a dictionary ICCIDs as (unique) keys, and an item array keeping the row to be updated, the concatenated country names and the cumulated necessary values. Using arrays and a dictionary, deleting the duplicate rows at once, it should be fast enough:
Sub mergeICCID()
Dim sh As Worksheet, lastR As Long, arr, arrInt, i As Long, j As Long, iRow As Long, rngDel As Range, dict As Object
Set sh = ActiveSheet
lastR = sh.Range("B" & sh.rows.count).End(xlUp).row 'last row in B:B
arr = sh.Range("B2:Q" & lastR).Value2 'place the range in an array for faster iteration and processing
Set dict = CreateObject("Scripting.Dictionary") 'set the dictionary
'fill the dictionary:
For i = 1 To UBound(arr)
If Not dict.Exists(arr(i, 1)) Then
dict.Add arr(i, 1), Array(i, arr(i, 12), arr(i, 14), arr(i, 15), arr(i, 16))
Else
arrInt = dict(arr(i, 1)) 'extract the item array
arrInt(1) = arrInt(1) & ", " & arr(i, 12): arrInt(2) = arrInt(2) arr(i, 14) 'concatenate country names and cumullate Usage Days
arrInt(3) = arrInt(3) arr(i, 15): arrInt(4) = arrInt(4) arr(i, 16) 'cummulate Usage value and Usage in Gb value
dict(arr(i, 1)) = arrInt 'put back the adapted item array
addToRange rngDel, sh.Range("A" & i 1) 'set the UNION range keeping rows to be deleted (at once) at the end
End If
Next i
'Change the cumulated/concatenated array elements:
For i = 0 To dict.count - 1
iRow = dict.Items()(i)(0)
arr(iRow, 12) = dict.Items()(i)(1) 'concatenated country names
arr(iRow, 14) = dict.Items()(i)(2) 'cumulated Usage Days value
arr(iRow, 15) = dict.Items()(i)(3) 'cumulated Usage value
arr(iRow, 16) = dict.Items()(i)(4) 'cumulated Usage in Gb value
Next i
'drop back the updated array content:
sh.Range("B2").Resize(UBound(arr), UBound(arr, 2)).Value2 = arr
'delete the duplicate rows, at once:
If Not rngDel Is Nothing Then rngDel.EntireRow.Delete
MsgBox "Ready..."
End Sub
Private Sub addToRange(rngU As Range, rng As Range)
If rngU Is Nothing Then
Set rngU = rng
Else
Set rngU = Union(rngU, rng)
End If
End Sub
Please, send some feedback after testing it.
Edited:
Please, try the next version, which does not update the range from A:A to L:L and process only cases having "EU" in N:N column:
Sub mergeICCID2Arrays()
Dim sh As Worksheet, lastR As Long, arrB, arr, arrInt, i As Long, j As Long, iRow As Long, rngDel As Range, dict As Object
Set sh = ActiveSheet
lastR = sh.Range("B" & sh.rows.count).End(xlUp).row 'last row in B:B
arrB = sh.Range("B2:B" & lastR).Value 'place the B:B range in an array (to be used only for setting the dictionary keys)
arr = sh.Range("M2:P" & lastR).Value2 'place the range in an array for faster iteration and processing
Set dict = CreateObject("Scripting.Dictionary") 'set the dictionary
'fill the dictionary:
For i = 1 To UBound(arr)
If arr(i, 2) = "EU" Then 'process only cases having "EU" in column N:N
If Not dict.Exists(arrB(i, 1)) Then
dict.Add arrB(i, 1), Array(i, arr(i, 1), arr(i, 3), arr(i, 4))
Else
arrInt = dict(arrB(i, 1)) 'extract the item array
arrInt(1) = arrInt(1) & ", " & arr(i, 1) 'concatenate country names
arrInt(2) = arrInt(2) arr(i, 3): arrInt(3) = arrInt(3) arr(i, 4) 'cummulate Usage Days and Usage values
dict(arrB(i, 1)) = arrInt 'put back the adapted item aray
addToRange rngDel, sh.Range("A" & i 1) 'set the range keeping rows to be deleted
End If
End If
Next i
'Change the cumulated/concatenated array elements:
For i = 0 To dict.count - 1
iRow = dict.Items()(i)(0)
arr(iRow, 1) = dict.Items()(i)(1) 'concatenated country names
arr(iRow, 3) = dict.Items()(i)(2) 'cummulated Usage Days value
arr(iRow, 4) = dict.Items()(i)(3) 'cummulated Usage value
Next i
'drop the adapted array content, at once:
sh.Range("M2").Resize(UBound(arr), UBound(arr, 2)).Value2 = arr
'delete the duplicate rows, at once:
If Not rngDel Is Nothing Then rngDel.EntireRow.Delete
End Sub