VBA to create new lines of data

[jmewebb]

Data separated by a comma in column "I" need to create a new row as shown under "Convert to:". The original data file already contains approximately 200k rows. I had another code but it took hours to run.

 

[jmewebb]

ReDim Result(1 To UBound(Data) * 1.5, 1 To 9) 'allows for 50% extra rows, increase if necessary

Sorry, it's this one...
Data = Range("FSM-Product-Contract-Activities!A2:I181463") 'change this to point to your data

 

[Joe4]

OK, I rarely use "ReDim", so I cannot really comment on his code. So I have come up with my own.
Try this:

Sub MyCopy()

    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim lr As Long, r As Long, nr As Long
    Dim arr() As String
    Dim i As Long

    Application.ScreenUpdating = False
    
'   Set worksheets
    Set ws1 = Sheets("Sheet1")
    Set ws2 = Sheets("Sheet2")
    
'   Initialize row counter for sheet 2
    nr = 3
    
'   Find last row with data in column A on first sheet
    ws1.Activate
    lr = ws1.Cells(Rows.Count, "A").End(xlUp).Row
    
'   Loop through each row on data sheet starting on row 3
    For r = 3 To lr
'       Split values in column I into array
        arr = Split(ws1.Cells(r, "I"), ",")
'       Loop through array
        For i = LBound(arr) To UBound(arr)
'           Copy over columns A:H
            ws1.Range(Cells(r, "A"), Cells(r, "H")).Copy ws2.Range("A" & nr)
'           Populate column I
            ws2.Range("I" & nr) = Trim(arr(i))
'           Increment new row counter
            nr = nr + 1
        Next i
    Next r
    
    Application.ScreenUpdating = True

    MsgBox "Macro complete!"
    
End Sub

I tried to document it all so you could see what is going on, and make adjustments where necessary.

 

[Joe4]

Sorry, it's this one...
Data = Range("FSM-Product-Contract-Activities!A2:I181463") 'change this to point to your data

Its possible that may be too many values to store in there (9 x 181462 values!).

See if my the code in my last post works for you.

 

[jmewebb]

Its possible that may be too many values to store in there (9 x 181462 values!).

See if my the code in my last post works for you.

No errors on your code but it doesn't do anything.

 

[Joe4]

No errors on your code but it doesn't do anything.

Then something probably doesn't match up. I copied the sample you posted and it worked perfectly on that.
Make sure that the sheet names and ranges in the code have been updated to match your exact situation.

 

[jmewebb]

Then something probably doesn't match up. I copied the sample you posted and it worked perfectly on that.
Make sure that the sheet names and ranges in the code have been updated to match your exact situation.

I only have one worksheet, which is worksheet2 named "FSM-Product-Contract-Activities".

 

[Joe4]

The code is written to write the results to a new worksheet in the same workbook.
Is it feasible to add a new sheet, and have it do that?

If we were to do it on the same sheet and you already have over 200k records on the one sheet, you would need to scroll down quite a ways to see the new data.

 

[jmewebb]

The code is written to write the results to a new worksheet in the same workbook.
Is it feasible to add a new sheet, and have it do that?

If we were to do it on the same sheet and you already have over 200k records on the one sheet, you would need to scroll down quite a ways to see the new data.

Added a sheet. Put the data in Sheet1, Sheet2 is blank. Now I get this message..

 

[Joe4]

If you step into your code, and run it one line at a time by using the F8 key, what line of code triggers that error message to pop up?

 

[jmewebb]

If you step into your code, and run it one line at a time by using the F8 key, what line of code triggers that error message to pop up?

BINGO!!! We have a winner! Finally got it to work. Thank you so very much for all of your expertise!