• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

using to dictionary to select range to merge

I am using the following code :

Code:
Sub countThings()
    Dim ws As Worksheet
    Dim countries As Object
    
    Application.ScreenUpdating = False
    
    Set ws = Sheets("gsv")
        
    Set countries = CreateObject("Scripting.Dictionary")
  
        For x = 6 To 75
            If Not countries.exists(ws.Range("A" & x).Value) Then
            countries.Add ws.Range("A" & x).Value, 1
                Else
            countries(ws.Range("A" & x).Value) = countries(ws.Range("A" & x).Value) + 1
            End If
  
        Next x
  
' programme segment to select the rows to merge
' coding first to identify the first position of name of the country
' first step will be to identify items which have got value >1

     Dim scroll As Integer
      
        For scroll = 0 To countries.Count - 1
      
            Debug.Print countries.items()(scroll), _
            countries.keys()(scroll)
      
        Next scroll
      
End Sub

but I am not able to write the code which will do the following :

1. Select items with value more than 1
2. For those items, get the values for the keys
3. For those keys, find the cell address
4. merge the rows whereby the number of rows to merge is supplied by the corresponding item value

the file and macro attached

Mod Edit: Code tags added
 

Attachments

  • ADM Historic Performance at F18FX_doodle.xlsm
    223.2 KB · Views: 6
Last edited by a moderator:
That sounds like a hard way to go about it, especially if there are similar names in different countries (same names in non-contiguous ranges in column A).
To get you started , try:
Code:
Sub blah()
StartRw = 6
EndRw = 75
StartBlock = StartRw
Do Until StartBlock > EndRw
  EndBlock = StartBlock
  Do Until Cells(StartBlock, 1) <> Cells(EndBlock + 1, 1) Or EndBlock >= EndRw
    EndBlock = EndBlock + 1
  Loop
  If EndBlock <> StartBlock Then
    Range(Cells(StartBlock, 1), Cells(EndBlock, 1)).Select
    MsgBox "Pause to show next rows to merge"
  End If
  StartBlock = EndBlock + 1
Loop
End Sub
 
thanks - this will work. I have used similar algo to solve this. the reason i posted this was to try the dictionary route as i have just started using this and find it very powerful. would have a trick to get here using the dictionary route
That sounds like a hard way to go about it, especially if there are similar names in different countries (same names in non-contiguous ranges in column A).
To get you started , try:
Code:
Sub blah()
StartRw = 6
EndRw = 75
StartBlock = StartRw
Do Until StartBlock > EndRw
  EndBlock = StartBlock
  Do Until Cells(StartBlock, 1) <> Cells(EndBlock + 1, 1) Or EndBlock >= EndRw
    EndBlock = EndBlock + 1
  Loop
  If EndBlock <> StartBlock Then
    Range(Cells(StartBlock, 1), Cells(EndBlock, 1)).Select
    MsgBox "Pause to show next rows to merge"
  End If
  StartBlock = EndBlock + 1
Loop
End Sub
 
As p45cal indicated. Scripting.Dictionary isn't the ideal method for this operation.

Also, your explanation is bit unclear on what calculation should be performed on ranges to merge (simple addition?). And what values should be kept for Brand column etc.

Just as FYI, here's some examples of using dictionary.

1. To count occurrence of each value in Column A, excluding blanks. Note that it's faster to loop using Range object rather than row index.

Code:
Sub Demo()
Dim dic As Object, Key
Dim cel as Range
Set dic = CreateObject("Scripting.Dictionary")
For Each cel In Range("A6:A75")
    If cel.Value <> "" Then _
    dic(cel.Value) = IIf(dic(cel.Value) = 0, 1, dic(cel.Value) + 1)
Next
For Each Key In dic.Keys
    If dic(Key) > 1 Then Debug.Print Key & " has "; dic(Key) & " items"
Next
End Sub

2. To store range object that needs merging directly into dictionary.
Code:
Sub Demo()
Dim dic As Object, Key, rCount
Dim cel As Range
Set dic = CreateObject("Scripting.Dictionary")
For Each cel In Range("A6:A75")
    If cel.Value <> "" Then
        rCount = Evaluate("=SUMPRODUCT((--EXACT(" & Chr(34) & cel.Value & Chr(34) & ", GSV!$A$6:$A$75)))")
        If rCount > 1 Then
            If Not dic.Exists(cel.Value) Then _
            dic.Add Key:=cel.Value, Item:=Range(cel, cel.Offset(rCount - 1))
        End If
    End If
Next

For Each Key In dic.Keys
    Debug.Print Key & " has address range " & dic(Key).Address & " to merge"
Next
End Sub
 
As p45cal indicated. Scripting.Dictionary isn't the ideal method for this operation.

thanks Chihiro - elegant pieces of code both.

can i bug you by asking some help in understanding the logic flow of the code segments 1 and 2?

the task I have is confined to col A only - all it should do is identify the cells which have duplicate entries , then select that particular range.address and finally merge the rows in that range.

Also, your explanation is bit unclear on what calculation should be performed on ranges to merge (simple addition?). And what values should be kept for Brand column etc.

Just as FYI, here's some examples of using dictionary.

1. To count occurrence of each value in Column A, excluding blanks. Note that it's faster to loop using Range object rather than row index.

Code:
Sub Demo()
Dim dic As Object, Key
Dim cel as Range
Set dic = CreateObject("Scripting.Dictionary")
For Each cel In Range("A6:A75")
    If cel.Value <> "" Then _
    dic(cel.Value) = IIf(dic(cel.Value) = 0, 1, dic(cel.Value) + 1)
Next
For Each Key In dic.Keys
    If dic(Key) > 1 Then Debug.Print Key & " has "; dic(Key) & " items"
Next
End Sub

2. To store range object that needs merging directly into dictionary.
Code:
Sub Demo()
Dim dic As Object, Key, rCount
Dim cel As Range
Set dic = CreateObject("Scripting.Dictionary")
For Each cel In Range("A6:A75")
    If cel.Value <> "" Then
        rCount = Evaluate("=SUMPRODUCT((--EXACT(" & Chr(34) & cel.Value & Chr(34) & ", GSV!$A$6:$A$75)))")
        If rCount > 1 Then
            If Not dic.Exists(cel.Value) Then _
            dic.Add Key:=cel.Value, Item:=Range(cel, cel.Offset(rCount - 1))
        End If
    End If
Next

For Each Key In dic.Keys
    Debug.Print Key & " has address range " & dic(Key).Address & " to merge"
Next
End Sub
 
Use the 2nd code then. Since dictionary stores the range object itself.
"dic(Key).Merge" will work same as Range("Cell:Cell").Merge

Code:
Sub Demo()
Dim dic As Object, Key, rCount
Dim cel As Range
Application.DisplayAlerts = False

Set dic = CreateObject("Scripting.Dictionary")
For Each cel In Range("A6:A75")
    If cel.Value <> "" Then
        rCount = Evaluate("=SUMPRODUCT((--EXACT(" & Chr(34) & cel.Value & Chr(34) & ", GSV!$A$6:$A$75)))")
        If rCount > 1 Then
            If Not dic.Exists(cel.Value) Then _
            dic.Add Key:=cel.Value, Item:=Range(cel, cel.Offset(rCount - 1))
        End If
    End If
Next

For Each Key In dic.Keys
    dic(Key).Merge
Next
Application.DisplayAlerts = True
End Sub
 
Back
Top