VBA row of data into several rows

mrhoden

New Member
Joined
Mar 5, 2016
Messages
10
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

Well-known Member
Joined
Jun 2, 2016
Messages
3,401
No concrete data to go on so this is untested. Please try on a copy of the data:

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 - 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
 
Last edited:

mrhoden

New Member
Joined
Mar 5, 2016
Messages
10
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

Well-known Member
Joined
Jun 2, 2016
Messages
3,401
Updated code:

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

New Member
Joined
Mar 5, 2016
Messages
10
You're a star! Thanks so much for this. I appreciate your help.
 

Nairolf

New Member
Joined
Jul 6, 2016
Messages
3
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
 
Last edited by a moderator:

wideboydixon

Well-known Member
Joined
Jun 2, 2016
Messages
3,401
Something like this?

Code:
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

New Member
Joined
Jul 6, 2016
Messages
3
It works just fine, until row 700, and i have 3000. Do you have any idea why ?
 

Forum statistics

Threads
1,082,099
Messages
5,363,129
Members
400,720
Latest member
Pettel

Some videos you may like

This Week's Hot Topics

  • populate from drop list with multiple tables
    Hi All, i have a drop list that displays data, what i want is when i select one of those from the list to populate text from different tables on...
  • Find list of words from sheet2 in sheet1 before a comma and extract text vba
    Hi Friends, Trying to find the solution on my task. But did not find suitable one to the need. Here is my query and sample file with details...
  • Dynamic Formula entry - VBA code sought
    Hello, really hope one of you experts can help with this - i've spent hours on this and getting no-where. .I have a set of data (more rows than...
  • Listbox Header
    Have a named range called "AccidentsHeader" Within my code I have: [CODE]Private Sub CommandButton1_Click() ListBox1.RowSource =...
  • Complex Heat Map using conditional formatting
    Good day excel world. I have a concern. Below link have a list of countries that carries each country unique data. [URL...
  • Conditional formatting
    Hi good morning, hope you can help me please, I have cells P4:P54 and if this cell is equal to 1 then i want row O to say "Fully Utilised" and to...
Top