Thread: assigning variables in consecutive order

what do you mean by dictionary?
I didn't post a workbook, because I thought it would be easier to just copy and paste that example data set into an excel workbook.
thank you for taking a crack at this!

Hello alexramo,

From your post I gather you're looking for an example workbook. The attached workbook has a button on Sheet1 to run the macro. When the macro runs, Sheet2 is cleared, except for row 1 and the groups are copied in the order they are found with their Sheet1 addresses beside them. You will probably want to do something else. This is to demonstrate how the disparate cells (non contiguous) can be regrouped into a contiguous range for sorting later. Here is the macro code...

Sub Macro1()

  Dim Addx As String
  Dim Cell As Range
  Dim DSO As Object
  Dim DstStartRow
  Dim DstWks As Worksheet
  Dim LastRow As Long
  Dim Rng As Range
  Dim SrcStartRow As Long
  Dim SrcWks As Worksheet
  
   'Setup the Source Worksheet. The starting is row is 2. Header is in row 1.
    SrcStartRow = 2
    Set SrcWks = Worksheets("Sheet1")
    
   'Setup the Destination Worksheet and clear it, except for the header row.
    DstStartRow = 2
    Set DstWks = Worksheets("Sheet2")
    DstWks.UsedRange.Offset(1, 0).ClearContents
    
     'Create the Dictionary Object
      Set DSO = Nothing
      Set DSO = CreateObject("Scripting.Dictionary")
      DSO.CompareMode = 1   'Text Compare - not case sensitive
    
     'Define the range of cells to be grouped on the Source Worksheet.
      With SrcWks
        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        LastRow = IIf(LastRow < StartRow, StartRow, LastRow)
        Set Rng = .Range(.Cells(SrcStartRow, "A"), .Cells(LastRow, "A"))
      End With
      
     'Group like cell contents using the Dictionary Object
      For Each Cell In Rng
        If DSO.Exists(Cell.Text) Then
          Addx = Union(SrcWks.Range(DSO(Cell.Text)), Cell).Address
          DSO(Cell.Text) = Addx
        Else
          DSO.Add Key:=Cell.Text, Item:=Cell.Address
        End If
      Next Cell
      
       'Copy the groups, in the order they were found, to the Destination Worksheet
        For Each Key In DSO.Keys
          Set Rng = SrcWks.Range(DSO(Key))
            For Each Cell In Rng
              DstWks.Cells(DstStartRow, "A") = Key
              DstWks.Cells(DstStartRow, "B") = Cell.Address
              DstStartRow = DstStartRow + 1
            Next Cell
        Next Key
      
End Sub

Sincerely,
Leith Ross

Everbody, thank you for replying to this post.
Leith I have another question, and I aplogize before hand, for not including this in the original post, but if I had another column with numbers, corresponding to a house #, (as those names were actually streets), how would you go about sorting it by consecutive order, after you put the array into the sequential order that you had solved?
for instance,

145 HARPER
142 HARPER
200 MCKINLEY
139 HARPER
138 HARPER
137 HARPER
135 HARPER
134 HARPER
132 HARPER
131 HARPER
130 HARPER
121 HARPER
111 HARPER
4448 LINCOLN
212 MCKINLEY
221 MCKINLEY
40 ADAMS
43 ADAMS
7770 GRIFFITH
7772 GRIFFITH
7778 GRIFFITH
39 ADAMS
38 ADAMS
21 ADAMS
3252 GARFIELD
3245 GARFIELD
3232 GARFIELD
3221 GARFIELD
3233 GARFIELD
3234 GARFIELD
3235 GARFIELD
7769 GRIFFITH

I actually thought the code would be easier to understand(i am obviously not an expert!) and I would be able to add that extra sorting function, but I see that your solution, and also SHG's solution is way beyond my knowledge base.

Great work by the way, I'm going to do some research today and try to figure out how you did some of that coding, it's amazing. thank you again.
-alex

Hello Alex,

I updated the macro. Column "A" contains the houde number and "B" the street name. Each group is sorted in ascending order once is has been transferred to the second worksheet. The attached workbook has the macro added. Here is the code...

Sub Macro1()

  Dim Addx As String
  Dim Cell As Range
  Dim DSO As Object
  Dim DstStartRow
  Dim DstWks As Worksheet
  Dim LastRow As Long
  Dim Rng As Range
  Dim SrcStartRow As Long
  Dim SrcWks As Worksheet
  
   'Setup the Source Worksheet. The starting is row is 2. Header is in row 1.
    SrcStartRow = 2
    Set SrcWks = Worksheets("Sheet1")
    
   'Setup the Destination Worksheet and clear it, except for the header row.
    DstStartRow = 2
    Set DstWks = Worksheets("Sheet2")
    DstWks.UsedRange.Offset(1, 0).ClearContents
    
     'Create the Dictionary Object
      Set DSO = Nothing
      Set DSO = CreateObject("Scripting.Dictionary")
      DSO.CompareMode = 1   'Text Compare - not case sensitive
    
     'Define the range of cells to be grouped on the Source Worksheet.
      With SrcWks
        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        LastRow = IIf(LastRow < StartRow, StartRow, LastRow)
        Set Rng = .Range(.Cells(SrcStartRow, "A"), .Cells(LastRow, "A"))
      End With
      
     'Group like cell contents using the Dictionary Object
      For Each Cell In Rng
        If DSO.Exists(Cell.Text) Then
          Addx = Union(SrcWks.Range(DSO(Cell.Text)), Cell).Address
          DSO(Cell.Text) = Addx
        Else
          DSO.Add Key:=Cell.Text, Item:=Cell.Address
        End If
      Next Cell
      
       'Copy the groups, in the order they were found, to the Destination Worksheet
        For Each Key In DSO.Keys
          Set Rng = SrcWks.Range(DSO(Key))
            DstNextRow = DstStartRow
            For Each Cell In Rng
              DstWks.Cells(DstNextRow, "A") = Key
              DstWks.Cells(DstNextRow, "B") = Cell.Offset(0, 1)
              DstNextRow = DstNextRow + 1
            Next Cell
          With DstWks
            Set Rng = .Range(.Cells(DstStartRow, "A"), .Cells(DstNextRow - 1, "B"))
            Rng.Sort Key1:=.Cells(DstStartRow, "B"), Order1:=xlAscending
          End With
          DstStartRow = DstNextRow
        Next Key
      
End Sub

Sincerely,
Leith Ross

Hello Leith,
Thank you again for helping on this issue.
Unfortunately, when I opened the workbook and ran the macro, it didn't change the order at all, in fact it was a replica of the array on tab1.

I know I might not have made sense when I was explaining the sorting method, so below is an example of what it should look like:

11 HARPER
12 HARPER
17 HARPER
24 HARPER
53 HARPER
54 HARPER
60 HARPER
66 HARPER
68 HARPER
80 HARPER
157 HARPER
202 HARPER
121 MCKINLEY
230 MCKINLEY
870 MCKINLEY
515 LINCOLN
1209 ADAMS
3005 ADAMS
3921 ADAMS
4100 ADAMS
4405 ADAMS
72 GRIFFITH
1801 GRIFFITH
1980 GRIFFITH
2200 GRIFFITH
40 GARFIELD
58 GARFIELD
65 GARFIELD
87 GARFIELD
95 GARFIELD
99 GARFIELD
100 GARFIELD

Notice that it is in the order that it originally appreared(i grabbed it from the results of your first macro), and then also sorted in ascending order, based on the house address. Is this possible?
Thank you again for your help,
-alex

Hello Alex,

Sorry about that, this version is correct. I was working on the program while helping my daughter balance her checkbook. Couldn't see the forest for trees. This version is correct and already added to the attached wowrksheet.

Sub Macro1()

  Dim Addx As String
  Dim Cell As Range
  Dim DSO As Object
  Dim DstStartRow
  Dim DstWks As Worksheet
  Dim LastRow As Long
  Dim Rng As Range
  Dim SrcStartRow As Long
  Dim SrcWks As Worksheet
  
   'Setup the Source Worksheet. The starting is row is 2. Header is in row 1.
    SrcStartRow = 2
    Set SrcWks = Worksheets("Sheet1")
    
   'Setup the Destination Worksheet and clear it, except for the header row.
    DstStartRow = 2
    Set DstWks = Worksheets("Sheet2")
    DstWks.UsedRange.Offset(1, 0).ClearContents
    
     'Create the Dictionary Object
      Set DSO = Nothing
      Set DSO = CreateObject("Scripting.Dictionary")
      DSO.CompareMode = 1   'Text Compare - not case sensitive
    
     'Define the range of cells to be grouped on the Source Worksheet.
      With SrcWks
        LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
        LastRow = IIf(LastRow < StartRow, StartRow, LastRow)
        Set Rng = .Range(.Cells(SrcStartRow, "B"), .Cells(LastRow, "B"))
      End With
      
     'Group like cell contents using the Dictionary Object
      For Each Cell In Rng
        If DSO.Exists(Cell.Text) Then
          Addx = Union(SrcWks.Range(DSO(Cell.Text)), Cell).Address
          DSO(Cell.Text) = Addx
        Else
          DSO.Add Key:=Cell.Text, Item:=Cell.Address
        End If
      Next Cell
      
       'Copy the groups, in the order they were found, to the Destination Worksheet
        For Each Key In DSO.Keys
          Set Rng = SrcWks.Range(DSO(Key))
            DstNextRow = DstStartRow
            For Each Cell In Rng
              DstWks.Cells(DstNextRow, "A") = Cell.Offset(0, -1)
              DstWks.Cells(DstNextRow, "B") = Key
              DstNextRow = DstNextRow + 1
            Next Cell
         'Put house numbers in ascending order
          With DstWks
            Set Rng = .Range(.Cells(DstStartRow, "A"), .Cells(DstNextRow - 1, "B"))
            Rng.Sort Key1:=.Cells(DstStartRow, "A"), Order1:=xlAscending
          End With
          DstStartRow = DstNextRow
        Next Key
      
End Sub

Sincerely,
Leith Ross

Leith, thank you it works great, you might think I'm easily impressed, but I think it's amazing!

I appreciate all your help, and everyone that took a crack at it.
Take care,
-Alex