VBA row of data into several rows

[mrhoden]

G'day all,

I'm very new to vba and I was hoping somebody might be able to help me with some code for converting rows of racing data into a table. Each row has 6 columns of race info (A:F), then 8 columns of Horse #1 info (G:N), then 8 columns for Horse #2 (O:V) etc.

I would like Horse #2's info to be under Horse #1 (on the row below), then Horse #3 on the row below, and so on. I would still like each row to bring with it the race info from columns A:F. The issue is that each row has a different end point (due to the different number of horses in each race).

Sorry for the clumsy explanation. Any help on this task would be immensely appreciated.

Regards,

Marty

 

[wideboydixon]

No concrete data to go on so this is untested. Please try on a copy of the data:

Public Sub GetHorseData()

Dim lastRow As Long
Dim lastCol As Long
Dim thisRow As Long
Dim horseCount As Long
Dim thisHorse As Long

lastRow = Cells(Rows.Count, 1).End(xlUp).Row

thisRow = 1 ' Adjust to point to the first row with data
Do While thisRow <= lastRow
    lastCol = Cells(thisRow, Columns.Count).End(xlToLeft).Column
    horseCount = (lastCol - 6) / 8
    If horseCount > 1 Then
        lastRow = lastRow + horseCount - 1
        Rows(thisRow + 1).Resize(RowSize:=horseCount - 1).Insert
        For thisHorse = 2 To horseCount
           Range(Cells(thisRow + thisHorse - 1, 1), Cells(thisRow + thisHorse - 1, 6)).Value = Range(Cells(thisRow, 1), Cells(thisRow, 6)).Value
           Range(Cells(thisRow + thisHorse - 1, 7), Cells(thisRow + thisHorse - 1, 14)).Value = Range(Cells(thisRow, thisHorse * 8 - 1), Cells(thisRow, thisHorse * 8 + 6)).Value
           Range(Cells(thisRow, thisHorse * 8 - 1), Cells(thisRow, thisHorse * 8 + 6)).Clear
        Next thisHorse
    End If
    thisRow = thisRow + horseCount
Loop

End Sub

WBD

 

[mrhoden]

This is absolutely brilliant, thankyou WBD. I've run it through and there was one slight issue (at my end). Would you believe the winner has 8 columns, but every other runner has 7 columns... Is this a small adjustment? If it is time consuming I can just delete the extra (odds) column. Sorry...and thanks again.

Marty

 

[wideboydixon]

Updated code:

Public Sub GetHorseData()

Dim lastRow As Long
Dim lastCol As Long
Dim thisRow As Long
Dim horseCount As Long
Dim thisHorse As Long

lastRow = Cells(Rows.Count, 1).End(xlUp).Row

thisRow = 1 ' Adjust to point to the first row with data
Do While thisRow <= lastRow
    lastCol = Cells(thisRow, Columns.Count).End(xlToLeft).Column
    horseCount = (lastCol - 7) / 7
    If horseCount > 1 Then
        lastRow = lastRow + horseCount - 1
        Rows(thisRow + 1).Resize(RowSize:=horseCount - 1).Insert
        For thisHorse = 2 To horseCount
           Range(Cells(thisRow + thisHorse - 1, 1), Cells(thisRow + thisHorse - 1, 6)).Value = Range(Cells(thisRow, 1), Cells(thisRow, 6)).Value
           Range(Cells(thisRow + thisHorse - 1, 7), Cells(thisRow + thisHorse - 1, 13)).Value = Range(Cells(thisRow, thisHorse * 7 + 1), Cells(thisRow, thisHorse * 7 + 7)).Value
           Range(Cells(thisRow, thisHorse * 7 + 1), Cells(thisRow, thisHorse * 7 + 7)).Clear
        Next thisHorse
    End If
    thisRow = thisRow + horseCount
Loop

End Sub

WBD

 

[mrhoden]

You're a star! Thanks so much for this. I appreciate your help.

 

[wideboydixon]

You're a star! Thanks so much for this. I appreciate your help.

No worries

 

[Nairolf]

Hello WBD I have kind of same situation with about 3000 lines. Each row has 22 columns of session parameters (A:V), then 18 columns of session details (W:AN), then another 18 session details (AO:BF) etc.
The number of session details are different from one row to another, the maximum length is 20 (e.g. 20 x W:AN). My question is how can i transpose this information into :
ROW 1 - A1:V1 W1:AN1
ROW 2 - A1:V1 AO1:BF1
ROW 21 - A2:V1 W2:AN2
ROW 22 - A2:V2 AO2:BF2 and so on ...

just let me know if you need some other information from me.
i tried to insert a few rows to make an ideea

KIND regards !
Flo

 

[wideboydixon]

Something like this?

Public Sub SplitData()

Dim lastRow As Long
Dim lastCol As Long
Dim thisRow As Long
Dim dataCount As Long
Dim thisData As Long
Dim fixedColumns As Long
Dim columnsPerRow As Long

' Change these values as appropriate
fixedColumns = 22
columnsPerRow = 18

lastRow = Cells(Rows.Count, 1).End(xlUp).Row

thisRow = 2 ' Adjust to point to the first row with data
Do While thisRow <= lastRow
    lastCol = Cells(thisRow, Columns.Count).End(xlToLeft).Column
    dataCount = (lastCol - fixedColumns) / columnsPerRow
    If dataCount > 1 Then
        lastRow = lastRow + dataCount - 1
        Rows(thisRow + 1).Resize(RowSize:=dataCount - 1).Insert
        For thisData = 2 To dataCount
           Range(Cells(thisRow + thisData - 1, 1), Cells(thisRow + thisData - 1, fixedColumns)).Value = Range(Cells(thisRow, 1), Cells(thisRow, fixedColumns)).Value
           Range(Cells(thisRow + thisData - 1, fixedColumns + 1), Cells(thisRow + thisData - 1, fixedColumns + columnsPerRow)).Value = Range(Cells(thisRow, fixedColumns + (thisData - 1) * columnsPerRow + 1), Cells(thisRow, fixedColumns + thisData * columnsPerRow)).Value
           Range(Cells(thisRow, fixedColumns + (thisData - 1) * columnsPerRow + 1), Cells(thisRow, fixedColumns + thisData * columnsPerRow)).Clear
        Next thisData
    End If
    thisRow = thisRow + dataCount
    DoEvents
Loop

End Sub

WBD

 

[Nairolf]

YES MAN ! You are a Genius ! Thanks a lot

 

[Nairolf]

It works just fine, until row 700, and i have 3000. Do you have any idea why ?