Break record row into multiple rows

[gmaxey]

Hello, I can do some basic stuff with VBA in Excel but I'm stuck on a process and hoping someone here might help.

I can create a one dimensional array of data a write it to a new row in and existing workbook. Here is the basic process:

varValues = Split(Smith,A1,B1,C1,A2,B2,C2,A3,B3,C3?, ?,?)
m_oSheet.UsedRange 'Refresh UsedRange
lngLastRow = m_oSheet.UsedRange.Rows(m_oSheet.UsedRange.Rows.Count).Row
For lngIndex = 0 To UBound(varValues)
m_oSheet.Cells(lngLastRow + 1, lngIndex + 1).value = varValues(lngIndex)
Next lngIndex

The row single row of data looks like this:
Smith A1 B1 C1 A2 B2 C2 A3 B3 C3

This same process can be run again with a new set of data and the result could look like this:
Smith A1 B1 C1 A2 B2 C2 A3 B3 C3
Roberts A1 B1 C1 A2 B2 C2 A3 B3 C3

I need the data to look like this:
Smith A1 B1 C1
Smith A2 B2 C2
Smith A3 B3 C3
Roberts A1 B1 C1
Roberts A2 B2 C2
Roberts A3 B3 C3

My data set will always look the same. The source for each data set is a Word form where a named person inputs information sets about planned travel e.g., Trip A, Trip B and Trip C
I don't know if there is a function in Excel that I could run after the single rows are created or it would need to create and input a two dimensional array. If so, what code would I use to write the four data rows for each input.

Cross posted here as well: https://www.excelforum.com/word-programming-vba-macros/1395714-break-a-data-set-into-multiple-rows.html

Thank you.

[georgiboy]

I may have missed the point slightly but would it not be quicker to capture the range as a multidimendional array and just loop through the first value and fill in the blank names?

Something like:

Sub test()
Dim rng As Range, var As Variant, x As Long, nm As String

Set rng = Sheet1.UsedRange
var = rng.Value
For x = 1 To UBound(var)
If var(x, 1) <> vbNullString Then nm = var(x, 1) Else var(x, 1) = nm
Next x
rng = var
End Sub

[gmaxey]

georgiboy,

I don't understand your reply. Yes, it is possible that I wasn't clear. In the past I would process several hundred word forms received from staff and extract the data to an excel worksheet.

So with each form processed, the worksheet would grow by 1 row:

First form processed:
Smith A1 B1 C1 A2 B2 C2 A3 B3 C3

Second form processed:
Smith A1 B1 C1 A2 B2 C2 A3 B3 C3
Roberts A1 B1 C1 A2 B2 C2 A3 B3 C3

Third form processed:
Smith A1 B1 C1 A2 B2 C2 A3 B3 C3
Roberts A1 B1 C1 A2 B2 C2 A3 B3 C3
Miller A1 B1 C1 A2 B2 C2 A3 B3 C3

As each form is processed I need to either:

1) create the single row record as I currently am and then convert that new one row record to three rows e.g.,

After first form is processed, convert:

Smith A1 B1 C1 A2 B2 C2 A3 B3 C3

To:

Smith A1 B1 C1
Smith A2 B2 C2
Smith A3 B3 C3

After second form is processed, convert:
Smith A1 B1 C1
Smith A2 B2 C2
Smith A3 B3 C3
Roberts A1 B1 C1 A2 B2 C2 A3 B3 C3

To:
Smith A1 B1 C1
Smith A2 B2 C2
Smith A3 B3 C3
Roberts A1 B1 C1
Roberts A2 B2 C2
Roberts A3 B3 C3

and so on. Or,

2) Pass the data to Excel in such a way (two dimensional array??) so that as each data set is passed Excel automatically creates the three rows.

Hope that makes sense.

Thank you.

[georgiboy]

I think i get it, i was viewing the A1, A2 as values coming from a range:

Is the below closer to what you need:

Sub test3()
Dim var As Variant, x As Long, y As Long, z As Long
Dim oVar(2, 3) As Variant

var = Split("Smith,A1,B1,C1,A2,B2,C2,A3,B3,C3", ",")

oVar(x, 0) = var(0)
For y = 1 To UBound(var)
z = z + 1
If z = 4 Then z = 1: x = x + 1: oVar(x, 0) = var(0)
oVar(x, z) = var(y)
Next y

Range("A1").Resize(UBound(oVar) + 1, UBound(oVar, 2) + 1) = oVar
End Sub

[snb]

Sub M_snb()
sn = Split("Smith A1 B1 C1 A2 B2 C2 A3 B3 C3")
Cells(1, 1).Resize(, 4) = Array(sn(0), sn(1), sn(2), sn(3))
Cells(2, 1).Resize(, 4) = Array(sn(0), sn(4), sn(5), sn(6))
Cells(3, 1).Resize(, 4) = Array(sn(0), sn(7), sn(8), sn(9))
End Sub

[gmaxey]

Thank you very much. Perfect

[snb]

Alternative:


Sub M_snb()
ReDim sp(2, 3)
x = UBound(sp) + 1
y = UBound(sp, 2) + 1
sn = Split("Smith A1 B1 C1 A2 B2 C2 A3 B3 C3")

For j = 0 To x * y - 1
sp(j \ y, j Mod y) = sn(IIf(j Mod y = 0, 0, j - j \ y))
Next

Cells(1).Resize(x, y) = sp
End Sub

[georgiboy]

Alternative version is better as it only writes to the sheet once as in my example. The more rimes you write to a sheet the slower the code will run.