Sub GenerateCSVFiles()
Dim ws As Worksheet
Dim lastRow As Long, i As Long, j As Long
Dim csvContent As String
Dim gameName As String
Dim myFile As String
Dim fNum As Integer
Dim dict As Object
Dim itemCounter As Long
Dim csvFolderPath As String
Set dict = CreateObject("Scripting.Dictionary")
' Disable screen updating and alerts to improve performance and prevent pop-up messages
Application.ScreenUpdating = False
Application.DisplayAlerts = False
' Set the worksheet where your data resides
Set ws = ThisWorkbook.Sheets("Sheet1")
csvFolderPath = ThisWorkbook.Path & "\CSV_Files"
If Dir(csvFolderPath, vbDirectory) = "" Then
MkDir csvFolderPath
End If
' Find the last row with data in column D (assuming this is where game_name is)
lastRow = ws.Cells(ws.Rows.Count, "Q").End(xlUp).Row
' Loop through all the rows to collect unique game names
For i = 2 To lastRow
If Not IsEmpty(ws.Cells(i, 4).Value) Then
gameName = ws.Cells(i, 4).Value
If Not dict.Exists(gameName) Then
dict.Add gameName, True
End If
End If
Next i
' Process each unique game name
Dim key As Variant
For Each key In dict.Keys
gameName = key
gameRow = 0
' Sanitize the gameName to create a valid filename
sanitizedGameName = Replace(gameName, " ", "_")
sanitizedGameName = Replace(sanitizedGameName, "\", "_")
sanitizedGameName = Replace(sanitizedGameName, "/", "_")
sanitizedGameName = Replace(sanitizedGameName, ":", "_")
sanitizedGameName = Replace(sanitizedGameName, "*", "_")
sanitizedGameName = Replace(sanitizedGameName, "?", "_")
sanitizedGameName = Replace(sanitizedGameName, Chr(34), "_") ' Double quotes
sanitizedGameName = Replace(sanitizedGameName, "<", "_")
sanitizedGameName = Replace(sanitizedGameName, ">", "_")
sanitizedGameName = Replace(sanitizedGameName, "|", "_")
sanitizedGameName = Replace(sanitizedGameName, "&", "and")
sanitizedGameName = Replace(sanitizedGameName, ",", "")
sanitizedGameName = Replace(sanitizedGameName, "#", "Number")
' Ensure the filename is not too long
If Len(sanitizedGameName) > 200 Then ' Limit to 200 to leave room for date and extension
sanitizedGameName = Left(sanitizedGameName, 200)
End If
' Find the row number for the current gameName
For i = 2 To lastRow
If ws.Cells(i, 4).Value = gameName Then
gameRow = i
Exit For
End If
Next i
If gameRow > 0 Then
' Initialize the CSV content with the main headers
csvContent= "name,IMAGE,TOTAL_TICKETS,TOTAL_TICKETS_COLOR,TOTAL_TICKETS_TEXT,TOTAL_LOSING, _
TOTAL_LOSING_COLOR,TOTAL_LOSING_TEXT,TOTAL_WINNINGS,TOTAL_WINNINGS_COLOR, _
TOTAL_WINNINGS_TEXT" & vbCrLf
' Gather data for the specific gameName row
' You'll need to adjust the row number (2 in this case) to the row where the gameName is located
' We're using a For loop here but you could also directly reference each cell if preferred
Dim rowData As Range
Set rowData = ws.Rows(2) ' Change this to the row number where gameName data is
' Add the data for the game name and fixed image URL
csvContent = csvContent & """" & gameName & """," & _
"""https://plus.unsplash.com/premium_photo-1672280727393-ab6f0b26f527?auto=format&fit=crop&q=80& _
w=1989&ixlib=rb-4.0.3&ixid=M3wxMjA3fDB8MHxwaG90by1wYWdlfHx8fGVufDB8fHx8fA%3D%3D""," & _
"""" & rowData.Cells(gameRow, "N").Value & """," & _
"""" & rowData.Cells(gameRow, "R").Value & """," & _
"""" & rowData.Cells(gameRow, "S").Value & """," & _
"""" & rowData.Cells(gameRow, "O").Value & """," & _
"""" & rowData.Cells(gameRow, "T").Value & """," & _
"""" & rowData.Cells(gameRow, "U").Value & """," & _
"""" & rowData.Cells(gameRow, "M").Value & """," & _
"""" & rowData.Cells(gameRow, "V").Value & """," & _
"""" & rowData.Cells(gameRow, "W").Value & """" & vbCrLf
' Add the "Items" row
csvContent = csvContent & "Items" & vbCrLf
' Add the headers for the items section
csvContent = csvContent & "id,USD,TOTAL_PRIZES,ODDS_WINNINGS,IMG,COLOR,TEXT,POSITION" & vbCrLf
' Reset item counter for each game
itemCounter = 1
For j = 2 To lastRow
If ws.Cells(j, 4).Value = gameName Then
' The ID is a number, so it is converted to a string.
csvContent = csvContent & CStr(ws.Cells(j, "G").Value) & "," ' id (sr no)
' Check if the USD cell contains an error or is empty.
If Not IsError(ws.Cells(j, "H").Value) And Not IsEmpty(ws.Cells(j, "H").Value) Then
csvContent = csvContent & """$" & CStr(ws.Cells(j, "H").Value) & """," ' USD with $ sign
Else
csvContent = csvContent & """," ' Empty or error value in USD field
End If
' Convert numeric values to strings to avoid type mismatch errors.
csvContent = csvContent & CStr(ws.Cells(j, "L").Value) & "," ' TOTAL_PRIZES
csvContent = csvContent & """'1 in " & CStr(ws.Cells(j, "X").Value) & """," ' ODDS_WINNINGS
csvContent = csvContent &"""https://upload.wikimedia.org/wikipedia/commons/thumb/b/b6/ _
Image_created_with_a_mobile_phone.png/220px-Image_created_with_a_mobile_phone.png""," ' IMG
csvContent = csvContent & """" & CStr(ws.Cells(j, "I").Value) & """," ' COLOR
csvContent = csvContent & """item " & CStr(ws.Cells(j, "G").Value) & """," ' TEXT (item x)
' Check if the POSITION cell contains an error or is empty.
If Not IsError(ws.Cells(j, "P").Value) And Not IsEmpty(ws.Cells(j, "P").Value) Then
csvContent = csvContent & CStr(ws.Cells(j, "P").Value) ' POSITION
Else
csvContent = csvContent & "" ' Empty or error value in POSITION field
End If
csvContent = csvContent & vbCrLf ' New line at the end of the row
End If
Next j
' Create a valid filename based on the game name and current date-time
gameName = Replace(gameName, " ", "_")
gameName = Replace(gameName, "/", "_")
gameName = Replace(gameName, "\", "_")
gameName = Replace(gameName, ":", "_")
myFile = csvFolderPath & "\" & sanitizedGameName & "-" & Format(Now, "ddd MMM dd yyyy HH_nn_ss") & _
" GMT+0530 (India Standard Time).csv"
' Write the CSV content to a file
fNum = FreeFile
Open myFile For Output As fNum
Print #fNum, csvContent
Close fNum
End If
Next key
' Re-enable screen updating and alerts
Application.ScreenUpdating = True
Application.DisplayAlerts = True
MsgBox "CSV files generated successfully!"
End Sub
Reply With Quote