analyze and export based on multiple criteria

[slash32487]

Download files - Filemail

Click here to view and download these shared files from Filemail.com

www.filemail.com

a link to the workbook

I have an Excel workbook named "Overall Auction Values redo," and I need to run a VBA macro to determine the best-case scenario using specific data. The data is found in the "Overall Auction Values" sheet, which contains 9 columns: Player Name, Cost, Team, Position (Pos), Points (PTS), Rebounds (REB), Assists (AST), Steals (STL), and Blocks (BLK). The "Position" column won't be used in the final analysis, but it can be added to display the data.

The second sheet is labeled "Schedule" and consists of two columns: Date and Team. The "Team" column references the "Overall Auction Values" sheet.

I need to select a total of 14 player names while ensuring that the total cost of all the players does not exceed $200. For example, I can select players like Joel Embiid, Anthony Edwards, Myles Turner, Nic Claxton, Kawhi Leonard, Ja Morant, Brandon Miller, Wendell Carter, Tyrese Maxey, Jalen Green, Spencer Dinwiddie, Deni Avdija, Keldon Johnson, and Jakob Poeltl, and still stay within budget (under by $2).

Now, let's consider analyzing the player data. Each player has averages for PTS, REB, AST, STL, and BLK. The goal when selecting the 14 players is to focus on three of these categories. Since there are five categories, there are 10 possible combinations of categories to consider:

1. PTS, REB, AST
2. PTS, REB, STL
3. PTS, REB, BLK
4. PTS, AST, STL
5. PTS, AST, BLK
6. PTS, STL, BLK
7. REB, AST, STL
8. REB, AST, BLK
9. REB, STL, BLK
10. AST, STL, BLK

Once this focus is created, the next level of analysis involves selecting which 10 players to use on any given day. The schedules are broken down by weeks from Monday through Sunday. The objective is to avoid having more than 10 players playing on the same day and to maximize the number of games played per week throughout the entire season while selecting those players accordingly. below is where im stuck. i cant get the code to push the values up to closer to $200 and i cannot figure out how to start working on the weeks.

Sub SelectBestPlayersAndExport()
Dim wsOverall As Worksheet
Dim wsSchedule As Worksheet
Dim wsExport As Worksheet
Dim lastRow As Long
Dim totalCost As Double
Dim selectedPlayers As Collection
Set selectedPlayers = New Collection

' Set references to the worksheets
Set wsOverall = ThisWorkbook.Sheets("Overall Auction Values")
Set wsSchedule = ThisWorkbook.Sheets("Schedule")

' Find the last row in the "Overall Auction Values" sheet
lastRow = wsOverall.Cells(wsOverall.Rows.Count, "A").End(xlUp).Row

' Create a new worksheet for exporting selected players
Set wsExport = ThisWorkbook.Sheets.Add
wsExport.Name = "Selected Players"

' Add headers to the new sheet
wsExport.Cells(1, 1).Value = "Player Name"
wsExport.Cells(1, 2).Value = "Cost"

' Set number format for cost as Accounting
wsExport.Cells(1, 2).NumberFormat = "_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(@_)"

' Continue selecting players randomly until the budget is met
Do While totalCost < 200 And selectedPlayers.Count < 14
' Generate a random row within the data range
randomRow = Int((lastRow - 2 + 1) * Rnd + 2)
playerCost = wsOverall.Cells(randomRow, 2).Value ' Assuming cost is in column B
Dim playerName As String
playerName = wsOverall.Cells(randomRow, 1).Value ' Assuming player name is in column A

' Check if adding the player is within the budget
If totalCost + playerCost <= 200 And Not PlayerAlreadySelected(selectedPlayers, playerName) Then
selectedPlayers.Add playerName
totalCost = totalCost + playerCost
' Write player data to the export sheet
wsExport.Cells(selectedPlayers.Count + 1, 1).Value = playerName
wsExport.Cells(selectedPlayers.Count + 1, 2).Value = playerCost
End If
Loop

' Analyze the selected players focusing on three categories for each player
AnalyzePlayers wsOverall, wsExport

End Sub

Sub AnalyzePlayers(wsOverall As Worksheet, wsExport As Worksheet)
Dim lastRow As Long
Dim numPlayers As Integer
lastRow = wsOverall.Cells(wsOverall.Rows.Count, "A").End(xlUp).Row
numPlayers = wsExport.Cells(wsExport.Rows.Count, 1).End(xlUp).Row - 1 ' Subtract 1 for the header

' Create headers for selected categories
wsExport.Cells(1, 4).Value = "Category 1"
wsExport.Cells(1, 5).Value = "Category 2"
wsExport.Cells(1, 6).Value = "Category 3"

' Define the categories you want to focus on (e.g., PTS, REB, AST)
Dim categories(1 To 3) As String
categories(1) = "PTS"
categories(2) = "REB"
categories(3) = "AST"

' Loop through the selected players and assign categories
For i = 2 To numPlayers + 1
Dim selectedPlayerName As String
selectedPlayerName = wsExport.Cells(i, 1).Value

' Find the player in the original data
For j = 2 To lastRow
If wsOverall.Cells(j, 1).Value = selectedPlayerName Then
' Assign categories to the selected player
For k = 1 To 3
wsExport.Cells(i, 3 + k).Value = wsOverall.Cells(j, Application.WorksheetFunction.Match(categories(k), wsOverall.Rows(1), 0)).Value
Next k
End If
Next j
Next i
End Sub

Function PlayerAlreadySelected(players As Collection, playerName As String) As Boolean
On Error Resume Next
PlayerAlreadySelected = Not IsEmpty(Application.Match(playerName, players, 0))
On Error GoTo 0
End Function