1. Welcome to Chandoo.org Forums. Short message for you

    Hi Guest,

    Thanks for joining Chandoo.org forums. We are here to make you awesome in Excel. Before you post your first question, please read this short introduction guide. When posting or responding to questions please remember our values at Chandoo.org are: Humility, Passion, Fun, Awesomeness, Simplicity, Sharing Remember that we have people here for whom English is not there first language and we need to allow for this in our dealings.

    Yours,
    Chandoo
  2. 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...

  3. 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

Discussion in 'VBA Macros' started by monoj chakraborty, Jul 17, 2017.

  1. monoj chakraborty

    monoj chakraborty New Member

    Messages:
    27
    I am using the following code :

    Code (vb):

    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

    Attached Files:

    Last edited by a moderator: Jul 17, 2017
  2. p45cal

    p45cal Well-Known Member

    Messages:
    718
    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 (vb):
    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
  3. monoj chakraborty

    monoj chakraborty New Member

    Messages:
    27
    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
  4. Chihiro

    Chihiro Well-Known Member

    Messages:
    3,318
    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 (vb):
    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 (vb):
    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
    Chirag R Raval likes this.
  5. monoj chakraborty

    monoj chakraborty New Member

    Messages:
    27
  6. Chihiro

    Chihiro Well-Known Member

    Messages:
    3,318
    Use the 2nd code then. Since dictionary stores the range object itself.
    "dic(Key).Merge" will work same as Range("Cell:Cell").Merge

    Code (vb):
    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

Share This Page