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

[Kamolga]

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)

[/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

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

 

[Kamolga]

I found a way to soort my collections for Regions and Persons

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

 

[Kamolga]

And I finally succeed in having texts AND numbers printed on the sheet by declaring the 2D array as variant

ReDim MyArray(1 To Regions.Count + 2, 1 To Persons.Count + 2) As Variant