Assign each element of an array to a variable

[cwb1021]

Hello Experts,

I have the following procedure which stores all the values in a column in an array. I'm wondering if there is a way to assign a variable to each element of the array? The array is dynamic, so the number of variables will be changing with each iteration.

Sub ArrayTest2()
Dim newarray() As String, msg As String
Dim j
Dim i As Long
Dim lr As Long
Dim counter As Long
lr = ActiveSheet.Range("BL" & Rows.Count).End(xlUp).Row
counter = 0
For i = 2 To lr
    If Worksheets("FilteredSet").Range("BL" & i).Value <> 0 Then
        ReDim Preserve newarray(counter)
        newarray(counter) = Worksheets("FilteredSet").Range("BL" & i).Value
        counter = counter + 1
    End If
Next
For i = LBound(newarray) To UBound(newarray)
    msg = msg & newarray(i) & vbNewLine
Next i
MsgBox "the values of my dynamic array are: " & vbNewLine & msg
End Sub

Thanks for your help!

Chris

[Paul_Hossler]

Seems to me that would defeat the purpose of using an array

Why do you want to do it that way?

[cwb1021]

Paul,

Yes I agree. Since posting this I've realized that assigning the variable would be a useless step. This is part of a bigger question which I had posted here:

http://www.vbaexpress.com/forum/show...ng-to-3-values

I thought that I would try and simplify the process by solving it in steps.

First, here is my goal - I have a column "BK" that has several values, most of which are repeated several times. In the adjacent column "BJ" are unique values for every row. So, for each unique value in column "BK" I would like to examine the unique values in column "BJ" and copy the entire row for the highest 3 values in "BJ" to a new worksheet. I've attached the worksheet with what I am hoping for as a result on worksheet "BHAStats".

I though that I would try to achieve this using these steps:


1. Evaluate the column "BK" in worksheet "FilteredSet" and store only unique values to an array "A". This is dynamic range and the number of unique values will change with each iteration. The values in column BK are actually a combination of 4 other columns. I combined them thinking I would simplify the code by only needing to compare values from 1 column.

2. Looping through each element in the new array "A", compare each value back to the values in column BK. If the values match, store the value in column BJ to another array "B". For each value in array "A" there would be an associate array of values in column "BJ". I though I would do this by assigning variable to the original array, which was my original question, but this as you said has no point.

3. For each array created from the values in column BJ copy/paste the row data of the highest 3 values to a new worksheet "BHAStats". Because the column BK will be dynamic, sometime there will only be 1 or 2 values, not a top 3.


And my only problem is, I don't know how to do any of this, ha! So here is the start of the code I had posted at the above link. You can see that it is not much, and I now think that creating a table and filtering will not help at all. I've reattached the workbook as well. ArrayMax.xlsm

[Sub TryAgain() 
Dim wsFS As Worksheet 
Dim LastRow 
Dim ROPRange As Range, RCell 
Set wsFS = Worksheets("FilteredSet") 
wsFS.ListObjects(1).Unlist 
wsFS.Range("BK1") = "Combined Stats" 
LastRow = wsFS.Cells(Cells.Rows.Count, "BJ").End(xlUp).Row 
Set ROPRange = wsFS.Range("BJ2:BJ" & LastRow) 
For Each RCell In ROPRange 
    If RCell.Value > 0 Then 
        RCell.Offset(, 1) = RCell.Offset(, -56) & "," & RCell.Offset(, -55) & "," & RCell.Offset(, -54) & "," & RCell.Offset(, -53) 
    End If 
Next 
 
wsFS.Range("A1").Select 
ActiveCell.CurrentRegion.Select 
Application.CutCopyMode = False 
ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A$1:$BK$33"), , xlYes).Name = _ 
"FSTable" 
Range("FSTable[#All]").Select 
 
ActiveWorkbook.Worksheets("FilteredSet").ListObjects("FSTable").Sort.SortFields _ 
.Clear 
ActiveWorkbook.Worksheets("FilteredSet").ListObjects("FSTable").Sort.SortFields _ 
.Add Key:=Range("FSTable[[#All],[Combined Stats]]"), SortOn:=xlSortOnValues _ 
, Order:=xlAscending, DataOption:=xlSortNormal 
With ActiveWorkbook.Worksheets("FilteredSet").ListObjects("FSTable").Sort 
    .Header = xlYes 
    .MatchCase = False 
    .Orientation = xlTopToBottom 
    .SortMethod = xlPinYin 
    .Apply 
End With 
End Sub

Any help or guidance as to how to go about this would be very much appreciated.

Thanks,

Chris

[Paul_Hossler]

Not thoroughly tested but seems to work with the data in your attachment and with my understanding of what you were looking to do

Also, I just used F, G, H, and I directly without making a combined field

Option Explicit
Sub Top3()
    Dim wsFiltered As Worksheet, wsStats As Worksheet, wsTemp As Worksheet
    Dim rFiltered As Range, rTemp As Range, rTemp1 As Range
    Dim i As Long, n As Long
    
    
    Application.ScreenUpdating = False
    
    
    'init
    Application.ScreenUpdating = False
    
    Set wsFiltered = Worksheets("FilteredSet")
    Set wsStats = Worksheets("BHAStats")
    Set rFiltered = wsFiltered.Cells(1, 1).CurrentRegion
    
    On Error Resume Next
    Application.DisplayAlerts = False
    Worksheets("Temp").Delete
    Application.DisplayAlerts = True
    On Error GoTo 0
    
    Worksheets.Add.Name = "Temp"
    Set wsTemp = ActiveSheet
    
    
    'copy filtered data to temp
    rFiltered.Columns(6).Copy wsTemp.Cells(1, 1)
    rFiltered.Columns(7).Copy wsTemp.Cells(1, 2)
    rFiltered.Columns(8).Copy wsTemp.Cells(1, 3)
    rFiltered.Columns(9).Copy wsTemp.Cells(1, 4)
    rFiltered.Columns(62).Copy wsTemp.Cells(1, 5)
    Set rTemp = wsTemp.Cells(1, 1).CurrentRegion
    Set rTemp1 = rTemp.Cells(2, 1).Resize(rTemp.Rows.Count - 1, rTemp.Columns.Count)
    
    
    
    
    'sort temp
    With wsTemp.Sort
        .SortFields.Clear
        .SortFields.Add Key:=rTemp1.Columns(1), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SortFields.Add Key:=rTemp1.Columns(2), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SortFields.Add Key:=rTemp1.Columns(3), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SortFields.Add Key:=rTemp1.Columns(4), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SortFields.Add Key:=rTemp1.Columns(5), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
        .SetRange rTemp
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    
    'look for first (highest) 3 matches
    With rTemp
            
        For i = 2 To .Rows.Count - 1
            If (.Cells(i, 1).Value = .Cells(i + 1, 1).Value) And _
                (.Cells(i, 2).Value = .Cells(i + 1, 2).Value) And _
                (.Cells(i, 3).Value = .Cells(i + 1, 3).Value) And _
                (.Cells(i, 4).Value = .Cells(i + 1, 4).Value) Then
                n = n + 1
                
                If n > 2 Then .Cells(i + 1, 5).Value = True     '   marker
                
            Else
                n = 0
            End If
        Next i
    End With
    
    'delete TRUE rows
    On Error Resume Next
    rTemp.Columns(5).SpecialCells(xlCellTypeConstants, xlLogical).EntireRow.Delete
    On Error GoTo 0
    
    
    'copy over to Stats (Note does not clear existing data)
    wsTemp.Columns(1).Copy wsStats.Cells(1, 6)
    wsTemp.Columns(2).Copy wsStats.Cells(1, 7)
    wsTemp.Columns(3).Copy wsStats.Cells(1, 8)
    wsTemp.Columns(4).Copy wsStats.Cells(1, 9)
    wsTemp.Columns(5).Copy wsStats.Cells(1, 62)
    
    'delete temp worksheet
    On Error Resume Next
    Application.DisplayAlerts = False
    Worksheets("Temp").Delete
    Application.DisplayAlerts = True
    On Error GoTo 0
    
    
    Application.ScreenUpdating = True
End Sub

[p45cal]

I think you can do this without vba; I can get the same results as Paul with a fairly standard pivot table (I suspect your expected results, cwb1021, might be slightly awry).
See attached, sheet BHAStats in the vicinity of cell D21.
Have I got it right?

Please note that in my pivot table I have used Avg Drlg ROP twice, the leftmost use of it was to make the rows unique, but this could fail if you have two or more equal Avg Drlg ROPs with the same combinations of County/Hole/Size/Formation/Section, but in the real world I'd imagine that you could use another column(s) to make sure the row is unique, perhaps latitude/longitude.

Also, I was hoping to put a bit of vba code in to drill down to detail by double-clicking on the Grand Total cell, which should create a new sheet with the rows from the source data which make up that grand total's value, only there appears to be a bug, in that when filtering using Top 10 (Top 3 in this case), the resulting new sheet contains all the records, not just the top 3.
However, I'm using Excel 2010; do either of you know whether this has been fixed in Excel 2013/2016/365 ?

[cwb1021]

Paul,

Thanks so much for your response. It works perfectly, and is also very clear.

p45cal - Thanks for your response as well. I do need this to be in vba because it is part of a larger project and will need to be sub procedure that is called from another procedure. And yes my results may have been off a little, this was done manually. I will definitely try your solution though for purposes of learning.


Thanks again!

Chris