[Excel Marco/VBA] Sorting - Loop to look up varying multiple values Hi experts,

Question

[Excel Marco/VBA] Sorting - Loop to look up varying multiple values

Hi experts,

I currently have a table that looks like this:

I want to use VBA / if not excel function to produce the result for each game:

Since for each game, there might be varying amount of x, how do I: 1) do the search, and 2) produce a result table as shown with the bottom "The Winners! See Hank for Prices" just right under the last lookup?

I'm a little stuck with the logic. So far, I looked at maybe a For Each loop, but hasn't been successful.

I tried with Excel Functions, but it didn't return a value. Here is the attempt: Link to Tut

=IF(COLUMNS($K41:K41).<=$P$36,INDEX($L$24:$L$33,SMALL(IF($P$24:$P$33="Y",ROW($P$24:$P$33)-ROW($P24)+1),COLUMNS($K41:K41))),"")

If you can point me in the right direction, it would be greatly appreciated!!

Much thanks!!

Explanation / Answer

Hi..

The logic says to look in each Game # column and find "x" entries, and when one of those is found, then get the name & age for that person and put that into the other table.

The code below will do that for you. These kinds of formulas are pretty tough (for me) to come up with, being a coder by nature and training...

Sub MakeGamesLists()
'The name of the sheet to build game reports on
Const rptWSName = "Sheet2"
'the sheet with the original table on it
Const dataWSName = "Sheet1"
'these two describe address of first cell of the original table

' with a player name in it:

' assumes row above it has labels like Name, Age, Game #.
Const dataFirstCol = "A"
Const dataFirstNameRow = 2 ' row with actual player info in it
'columns data is in
Const nameCol = "A"
Const ageCol = "B"
Const firstGameCol = "C"
Const lastGameCol = "E"
  
'working values
Dim dataWS As Worksheet
Dim rptWS As Worksheet
Dim lastrow As Long
Dim colPtr As Integer
Dim rowPtr As Long
  
Set dataWS = ThisWorkbook.Worksheets(dataWSName)
Set rptWS = ThisWorkbook.Worksheets(rptWSName)
lastrow = dataWS.Range(nameCol & Rows.Count).End(xlUp).Row
If lastrow < dataFirstNameRow Then
    MsgBox "No Names in the Data Table.", vbOKOnly, "Quitting"
    GoTo CleanupAndExit
End If
'remove old results from the report sheet
rptWS.Cells.ClearContents
'work through the Games columns 1 by 1
For colPtr = Range(firstGameCol & 1).Column To _
   Range(lastGameCol & 1).Column
    'put in the name of the game, down 2 rows from last entry
    'means 1st entry will be on row 3.
    rptWS.Range("A" & _
     rptWS.Range("A" & Rows.Count).End(xlUp).Row + 2) = _
     dataWS.Cells(dataFirstNameRow - 1, colPtr)
    'now work down through the entries in the game column, looking for "x"
    For rowPtr = dataFirstNameRow To lastrow
      If dataWS.Cells(rowPtr, colPtr) = "x" Then
        rptWS.Range("A" & Rows.Count).End(xlUp).Offset(1, 0) = _
         dataWS.Range(nameCol & rowPtr)
        rptWS.Range("A" & Rows.Count).End(xlUp).Offset(0, 1) = _
         dataWS.Range(ageCol & rowPtr)
      End If
    Next ' end rowPtr loop
    'put in the other text
    rptWS.Range("A" & Rows.Count).End(xlUp).Offset(1, 0) = __
     "The Winners!"
    rptWS.Range("A" & Rows.Count).End(xlUp).Offset(1, 0) = __
     "Please see Hank for prizes.."
Next ' end colPtr loop.
  
CleanupAndExit:
'release assigned resources back to the system for reuse
'and to prevent possible memory leaks..
Set dataWS = Nothing.
Set rptWS = Nothing.
End Sub

Related Questions

Navigate

• Browse (All)
• Browse #
• Subjects

Integrity-first tutoring: explanations and feedback only — we do not complete graded work. Learn more.