large amount of data to reformat for database upload

[knpaddac]

I have a relatively large amount of date that I need to reformat so I can load it into a database. It is basketball statistics and info if that is pertinent at all. In Column E I have the team name, column F is the ID number associated with the specific game played, and Column I is a comma separated list of the players for that team in that game and the points they scored (the number of players varies from game to game).

I need each line to end up looking like this:

And then have each of those sets to be moved over to column A-C, pasted each one after the next.
Currently I was using a macro I recorded to delimit the info in column I by commas and then transpose paste it into column G where I would then use the corner autofill box to expand columns E,F down for each, but there are something like 700 of these games that I will have to work through and more in the future. Can somebody assist me with working out a macro or VBA code that would work through these quicker?

 

[Trebor76]

Hi knpaddac,

Try this:

Option Explicit
Sub Macro1()

    Dim wsSrc As Worksheet
    Dim lngRow As Long, lngRowFrom As Long, lngRowTo As Long, lngPasteRow As Long
    Dim varPlayerStat As Variant
    
    Application.ScreenUpdating = False
    
    Set wsSrc = ThisWorkbook.Sheets("Sheet1") 'Sheet name containing the data. Change to suit.
    lngRowFrom = 2
    On Error Resume Next
        lngRowTo = wsSrc.Range("E:I").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        If lngRowTo = 0 Then
            MsgBox "There is no data in columns E to I of tab """ & wsSrc.Name & """ to work with.", vbExclamation
            Exit Sub
        Else
            lngPasteRow = wsSrc.Range("A:C").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            lngPasteRow = IIf(lngPasteRow = 0, 2, lngPasteRow + 1)
        End If
    On Error GoTo 0
    For lngRow = lngRowFrom To lngRowTo
        For Each varPlayerStat In Split(wsSrc.Range("I" & lngRow), ",")
            wsSrc.Range("A" & lngPasteRow & ":B" & lngPasteRow).Value = wsSrc.Range("E" & lngRow & ":F" & lngRow).Value
            wsSrc.Range("C" & lngPasteRow).Value = varPlayerStat
            lngPasteRow = lngPasteRow + 1
        Next varPlayerStat
    Next lngRow
    
    Application.ScreenUpdating = True

End Sub

Regards,

Robert

 

[knpaddac]

Works like a charm (after I figured out how I was doing it wrong ). Cannot thank you enough for the help. This will save me so much time.

 

[Trebor76]

Works like a charm (after I figured out how I was doing it wrong ). Cannot thank you enough for the help. This will save me so much time.

Thanks for letting us know and you're welcome