Basic question - create and fill X new rows based on instances of character in cell

[HenrikR]

Basically I'm trying to start from scratch with VBA to do what I can't figure out in Excel, so if my question is much too basic I apologize.

I have a sheet of data with 2035 rows and 5 columns. In column D of each row there is a text-string which contains several words separated by semi-colons, e.g. WORD1;WORD2;WORD3 (the number of words varies from 0 to 65). What I want to do in e.g. row 1 is count how many semi-colons there are in D1, insert that many new rows minus one below row 1 and then copy the contents of A1, B1, C1 and E1 to row 2 and insert WORD2 into D2 - and then move down to the next 'unprocessed' line and repeat the process.

Basically it currently looks like:

A1: [STRING1] B1: [STRING2] C1: [STRING3] D1: [WORD1;WORD2;WORD3] E1: [STRING4]

And I want it to look like:

A1: [STRING1] B1: [STRING2] C1: [STRING3] D1: [WORD1] E1: [STRING4]
A2: [STRING1] B2: [STRING2] C2: [STRING3] D2: [WORD2] E2: [STRING4]
A3: [STRING1] B3: [STRING2] C3: [STRING3] D3: [WORD3] E3: [STRING4]

I don't know if there's an easier way to do this without VBA but I haven't been able to figure one out, so I'm trying to see if I can tackle it in VBA. I'm doing this in Excel 32 bit for Microsoft 365. Any tips or suggestions for how to begin tackling this are highly welcome, thanks!

[p45cal]

Sub blah()
Set myRng = Cells(1).CurrentRegion
For rw = myRng.Rows.Count To 2 Step -1
'For rw = myRng.Rows.Count To 1 Step -1'use this instead of the line above if there are no headers at the top.
mystrarray = Split(Cells(rw, 4).Value, ";")
Rows(rw).Copy
Rows(rw + 1).Resize(UBound(mystrarray)).Insert
Cells(rw, 4).Resize(UBound(mystrarray) + 1).Value = Application.Transpose(mystrarray)
Next rw
End Sub

[HenrikR]

Sub blah()
Set myRng = Cells(1).CurrentRegion
For rw = myRng.Rows.Count To 2 Step -1
'For rw = myRng.Rows.Count To 1 Step -1'use this instead of the line above if there are no headers at the top.
mystrarray = Split(Cells(rw, 4).Value, ";")
Rows(rw).Copy
Rows(rw + 1).Resize(UBound(mystrarray)).Insert
Cells(rw, 4).Resize(UBound(mystrarray) + 1).Value = Application.Transpose(mystrarray)
Next rw
End Sub


Thanks! Unfortunately I get a Runtime error 1004 when I try to run this, and I'm not savvy enough to know why - it stops at row 7 of the module, before inserting any rows in the sheet. 'rw' is 2045 and UBound(mystrarray) = 0 but I don't know if that applies.

[p45cal]

It's best to attach an actual workbook.

[HenrikR]

That's good advice, I just didn't have the time to make an anonymized file without client info in it, but I will remember for next time. I solved it now with some incredibly crude For / Next loops, just inserting the appropriate number of blank lines and then copying the relevant material from the original line and moving to the next. Thanks for the help and the advice!

[p45cal]

Sub blah2()
Set myRng = Cells(1).CurrentRegion
For rw = myRng.Rows.Count To 2 Step -1
'For rw = myRng.Rows.Count To 1 Step -1'use this instead of the line above if there are no headers at the top.
mystrarray = Split(Cells(rw, 4).Value, ";")
If UBound(mystrarray) > 0 Then
Rows(rw).Copy
Rows(rw + 1).Resize(UBound(mystrarray)).Insert
Cells(rw, 4).Resize(UBound(mystrarray) + 1).Value = Application.Transpose(mystrarray)
End If
Next rw
Application.CutCopyMode = False
End Sub