VBA to create new lines of data

jmewebb

New Member
Joined
Dec 6, 2012
Messages
41
1625664922813.png


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

New Member
Joined
Dec 6, 2012
Messages
41
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
 

Excel Facts

Last used cell?
Press Ctrl+End to move to what Excel thinks is the last used cell.

Joe4

MrExcel MVP, Junior Admin
Joined
Aug 1, 2002
Messages
58,344
Office Version
  1. 365
Platform
  1. Windows
OK, I rarely use "ReDim", so I cannot really comment on his code. So I have come up with my own.
Try this:
VBA Code:
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.
 
Solution

Joe4

MrExcel MVP, Junior Admin
Joined
Aug 1, 2002
Messages
58,344
Office Version
  1. 365
Platform
  1. Windows
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.
 

Joe4

MrExcel MVP, Junior Admin
Joined
Aug 1, 2002
Messages
58,344
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

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

New Member
Joined
Dec 6, 2012
Messages
41
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

MrExcel MVP, Junior Admin
Joined
Aug 1, 2002
Messages
58,344
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

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

New Member
Joined
Dec 6, 2012
Messages
41
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..
1625749884570.png
 

Joe4

MrExcel MVP, Junior Admin
Joined
Aug 1, 2002
Messages
58,344
Office Version
  1. 365
Platform
  1. Windows
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

New Member
Joined
Dec 6, 2012
Messages
41
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!
 

Forum statistics

Threads
1,136,772
Messages
5,677,637
Members
419,707
Latest member
Anna vib

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top