VBA How to Sort collection Alphabetically? How to Dim 2 variables types in 2D Array?

Kamolga

Well-known Member
Joined
Jan 28, 2015
Messages
1,185
Hi,

I have two questions for my project below. I have a table TblSales in B:G and I try to do the equivalent of the pivot in L5:P10 by storing and calculating values in an Array (I put it in L13 to show result)

Capture.jpg
[/URL][/IMG]

The result is very close but as you can see the People are not sort Aphabetically as in Pivot and my array is dimensioned as string, so numbers are texts. I tried to dim it as long or integer but I had error with the text values.

Here is the code, I highlight in red both questions

Code:
Sub ArrayInsteadPivot()
[COLOR=#008000]'Define path to data table[/COLOR]
  Dim myTable As ListObject
  ShSales.Activate
  Set myTable = ActiveSheet.ListObjects("TblSAles")
[COLOR=#008000]'Set First Column[/COLOR]
    'Get Region Unique Values
      Dim Region As Variant
      Dim Regions As Collection
      Set Regions = New Collection
[COLOR=#008000]      'Loop through each Cell and Error on duplicate (add with same key)
[/COLOR]
    On Error Resume Next
       For Each Region In myTable.ListColumns(2).DataBodyRange
        [COLOR=#FF0000]'Question1: how can I sort those entries alphabetically?[/COLOR]
[COLOR=#FF0000]        Regions.Add Region, Region [/COLOR]
       Next Region
    On Error GoTo 0
[COLOR=#008000]'Set First Row[/COLOR]
[COLOR=#008000]    'Get Person Unique Values[/COLOR]
      Dim Person As Variant
      Dim Persons As Collection
      Set Persons = New Collection
[COLOR=#008000]      'Loop through each Cell and Error on duplicate (add with same key)[/COLOR]
    On Error Resume Next
       For Each Person In myTable.ListColumns(3).DataBodyRange
        Persons.Add Person, Person
       Next Person
    On Error GoTo 0
[COLOR=#008000]'Define Array (needs to use Redim instead of Dim to be abble to use variables, dim works only with constants 1,2,3,...) 
 [/COLOR][COLOR=#FF0000]' Question 2: how can I set up string for titles and long for data?[/COLOR]
[COLOR=#FF0000] ReDim MyArray(1 To Regions.Count + 2, 1 To Persons.Count + 2) As String [/COLOR]
    Dim r As Long 'row
    Dim c As Long 'column
        For r = 1 To Regions.Count + 2
            For c = 1 To Persons.Count + 2
[COLOR=#008000]            'First Row[/COLOR]
[COLOR=#008000]               'First Cell[/COLOR]
                   If (r = 1 And c = 1) Then
                       MyArray(r, c) = "Regions"
                   End If
[COLOR=#008000]               'Name of Person[/COLOR]
                   If (r = 1 And c > 1 And c < Persons.Count + 2) Then
                       MyArray(r, c) = Persons(c - 1)
                   End If
[COLOR=#008000]               'Last Cell first row[/COLOR]
                   If (r = 1 And c = Persons.Count + 2) Then
                       MyArray(r, c) = "Total"
                   End If
[COLOR=#008000]            'First Column[/COLOR]
[COLOR=#008000]               'Name of Regions[/COLOR]
                   If (r > 1 And r < Regions.Count + 2 And c = 1) Then
                       MyArray(r, c) = Regions(r - 1)
                   End If
[COLOR=#008000]               'Last Cell first column[/COLOR]
                   If (r = Regions.Count + 2 And c = 1) Then
                       MyArray(r, c) = "Total"
                   End If
[COLOR=#008000]               'Fill the sum per person per Region[/COLOR]
                   If (r > 1 And r < Regions.Count + 2 And c > 1 And c < Persons.Count + 2) Then
                       MyArray(r, c) = Application.WorksheetFunction.SumIfs(myTable.ListColumns(6).DataBodyRange, myTable.ListColumns(2).DataBodyRange, Regions(r - 1), myTable.ListColumns(3).DataBodyRange, Persons(c - 1))
                   End If
[COLOR=#008000]               'Fill Total per person[/COLOR]
                   If (r = Regions.Count + 2 And c > 1 And c < Persons.Count + 2) Then
                       MyArray(r, c) = Application.WorksheetFunction.SumIfs(myTable.ListColumns(6).DataBodyRange, myTable.ListColumns(3).DataBodyRange, Persons(c - 1))
                   End If
[COLOR=#008000]               'Fill Total per Regions[/COLOR]
                   If (r > 1 And r < Regions.Count + 2 And c = Persons.Count + 2) Then
                       MyArray(r, c) = Application.WorksheetFunction.SumIfs(myTable.ListColumns(6).DataBodyRange, myTable.ListColumns(2).DataBodyRange, Regions(r - 1))
                   End If
[COLOR=#008000]               'Fill Last cell Total[/COLOR]
                   If (r = Regions.Count + 2 And c = Persons.Count + 2) Then
                       MyArray(r, c) = Application.WorksheetFunction.Sum(myTable.ListColumns(6).DataBodyRange)
                   End If
            Next c
        Next r
[COLOR=#008000]    'Put Array from ActiveCell (L13)[/COLOR]
            Range("L13").Activate
            Dim aRow As Long
            Dim aCol As Long
            aRow = ActiveCell.Row
            aCol = ActiveCell.Column
      Range(ActiveCell, Cells(aRow + Regions.Count + 1, aCol + Persons.Count + 1)) = MyArray
End Sub
That is my first code with collection and array, so any tip on the code (certainly overcomplicated since it was build by correcting all possible errors we get in the learning phase) is also very welcome. Thanks in advance
 

Excel Facts

Back into an answer in Excel
Use Data, What-If Analysis, Goal Seek to find the correct input cell value to reach a desired result
I found a way to soort my collections for Regions and Persons

Code:
For ctr1 = 1 To Regions.Count - 1
            For ctr2 = ctr1 + 1 To Regions.Count
                If Regions(ctr1) > Regions(ctr2) Then
                    [COLOR=#008000]'store the lesser item[/COLOR]
                    Region = Regions(ctr2)
                   [COLOR=#008000] 'remove the lesser item[/COLOR]
                    Regions.Remove ctr2
                   [COLOR=#008000] 're-add the lesser item before the
                    'greater Item[/COLOR]
                    Regions.Add Region, Region, ctr1
                End If
            Next ctr2
Next ctr1
      [COLOR=#008000]  'test[/COLOR]
          For Each Region In Regions
             Debug.Print Region
          Next Region
 
Last edited:
Upvote 0
And I finally succeed in having texts AND numbers printed on the sheet by declaring the 2D array as variant

Code:
ReDim MyArray(1 To Regions.Count + 2, 1 To Persons.Count + 2) As Variant
 
Last edited:
Upvote 0

Forum statistics

Threads
1,223,098
Messages
6,170,100
Members
452,301
Latest member
QualityAssurance

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top