PDA

View Full Version : [SOLVED] Assign each element of an array to a variable



cwb1021
04-11-2017, 02:31 PM
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
04-11-2017, 03:28 PM
Seems to me that would defeat the purpose of using an array

Why do you want to do it that way?

cwb1021
04-11-2017, 03:56 PM
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/showthread.php?59145-Help-storing-values-in-Array-and-returning-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. 18909


[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
04-11-2017, 05:38 PM
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
04-11-2017, 07:19 PM
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
04-12-2017, 04:40 AM
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