cwb1021
04-11-2017, 07:54 AM
Good morning experts,
Im attempting something a bit above my experience level (which is not high:). I have a worksheet with many columns, and I would like to compare the values in 4 of these columns, and if they are equal store an offset column value in an array and then copy / paste the rows with the highest 3 values in descending order to a new worksheet. I realize that is probably confusing, so i'll try to explain with a before and after from the attached worksheet.
So, in the attached workbook on worksheet "FilteredSet", Im trying to compare the values in columns F to I. If all values in those columns match for a row, the value in column BJ for that row is stored in an array. Because there are several combinations, there would be several arrays. From the array, I would need to find the highest 3 values and copy paste those values corresponding row to a new worksheet.
The data on worksheets "BHAStats" is what I hope to accomplish. There are many blank columns, but these will have data eventually.
I tried to simplify this by first creating a new column (BK) which combines all 4 values and then sorting from A to Z. This way only one column needs to be evaluated instead of 4. For this I used the following code:
[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
But after this point, I am utterly lost as to what to do next.
Any suggestions on how to do this, or an easier way to accomplish this would be greatly appreciated!
Thanks,
Chris
Im attempting something a bit above my experience level (which is not high:). I have a worksheet with many columns, and I would like to compare the values in 4 of these columns, and if they are equal store an offset column value in an array and then copy / paste the rows with the highest 3 values in descending order to a new worksheet. I realize that is probably confusing, so i'll try to explain with a before and after from the attached worksheet.
So, in the attached workbook on worksheet "FilteredSet", Im trying to compare the values in columns F to I. If all values in those columns match for a row, the value in column BJ for that row is stored in an array. Because there are several combinations, there would be several arrays. From the array, I would need to find the highest 3 values and copy paste those values corresponding row to a new worksheet.
The data on worksheets "BHAStats" is what I hope to accomplish. There are many blank columns, but these will have data eventually.
I tried to simplify this by first creating a new column (BK) which combines all 4 values and then sorting from A to Z. This way only one column needs to be evaluated instead of 4. For this I used the following code:
[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
But after this point, I am utterly lost as to what to do next.
Any suggestions on how to do this, or an easier way to accomplish this would be greatly appreciated!
Thanks,
Chris