Home > Mobile >  Merge Rows & Sum Values ( removed merged ones)
Merge Rows & Sum Values ( removed merged ones)

Time:09-15

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 advanceenter image description here

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
  • Related