Macro To Insert Rows

Sand359

New Member
Joined
Jun 13, 2018
Messages
6
Hello All,

I have an interesting problem that I am trying to solve. Lets say I have a lot of data. In one column (Column T) it shows multiple states in the following format:
*AK*AR*CO*LA...

I would like to write a macro that will read the values in this column and insert a row based on how many states are listed, along with pasting a single state in the adjacent cell next to it on the newly inserted row. (Each Row would have a different state).

Thank you,
Sand359
 

Excel Facts

Select all contiguous cells
Pressing Ctrl+* (asterisk) will select the "current region" - all contiguous cells in all directions.
This code will split apart your data. I assumed it in A1 and the results are then in cells beneath it. You can modify as needed to fit your specifcs

Code:
Sub states()
    Dim i As Long, j As Long
    Dim target As String, wrd As variant
    target = Range("A1")
    Dim arr() As String
    arr = Split(target, "*")
    i = 2
    For Each wrd In arr()
        Cells(i, 1) = wrd
        i = i + 1
    Next wrd
End Sub
 
Last edited:
Upvote 0
Thank you Alan,

Looking at my post I realize I missed a part. I need the macro to copy the line, and insert it then add a single state to the end of the row. So lets say I have Invoices #, Contact Names, and then the States column. I want to break up states to instead of being in one cell, to each have their own line, with all of the other same information present.

Example:
From:
QneT9Tp
QneT9Tp
ABCD
1InvoiceContactStatesState
2123456John Smith*AK*AR*CO*LA

<tbody>
</tbody>

To This:
ABCD
1InvoiceContactStatesState
2123456John Smith*AK*AR*CO*LA*AK
3123456John Smith*AK*AR*CO*LA*AR
4123456John Smith*AK*AR*CO*LA*CO
5123456John Smith*AK*AR*CO*LA*LA

<tbody>
</tbody>
 
Upvote 0
Welcome to the MrExcel board!

Assuming that the list of states is in column T (as originally suggested) and that column U is available for the individual state abbreviations then try this in a copy of your workbook.

Code:
Sub OneLinePerState()
  Dim States As Variant
  Dim r As Long, lr As Long
  
  Application.ScreenUpdating = False
  lr = Range("T" & Rows.Count).End(xlUp).Row
  For r = lr To 2 Step -1
    States = Split(Mid(Range("T" & r).Value, 2), "*")
    If UBound(States) = 0 Then
      Range("U" & r).Value = States(0)
    Else
      Rows(r).Copy
      Rows(r + 1).Resize(UBound(States)).Insert
      Range("U" & r).Resize(UBound(States) + 1).Value = Application.Transpose(States)
    End If
  Next r
  Application.CutCopyMode = False
  Application.ScreenUpdating = True
End Sub
 
Upvote 0
Thank you so much Peter!

This worked almost flawlessly. I think I had too much data to run through it as I had over 2000 lines to do this to. But if I broke it up in batches of 200 it ran perfectly! Again thank you so much! You saved me days of copy and inserting!

Are there any books you could recommend in regards to learning VBA? I took VB about 15 years ago but haven't used it since and took some Java courses recently. But given that my current job is mostly working on reports in Excel and eventually the monster that is Access, I think it would be vastly beneficial to learn VBA.

Thanks again!
Sand359
 
Upvote 0
Thank you so much Peter!
You're welcome.


This worked almost flawlessly. I think I had too much data to run through it as I had over 2000 lines to do this to. But if I broke it up in batches of 200 it ran perfectly!
Glad you adapted to get something that worked for you but the number of rows should not affect whether the code works or not (unless there wasn't enough rows on the sheet to house the results, but that should not be the issue for you).
I just ran the code with 3,000 rows of similar data and it ran fine (though it did take about 15 seconds).

What happened when you ran it on your 2,000 rows?
- Did you get an error message?
- Did it do nothing?
- Did it rearrange incorrectly?
- Did it crash excel?
- Something else?


Are there any books you could recommend in regards to learning VBA?
I tend not to use books or formal resources but another forum member has put together a list of resources that you might find something of interest in.
 
Last edited:
Upvote 0
It gave me an error and froze Excel to the point where I had to use Task Manager to shut down Excel. I forget what the error message was though. This was a vast amount of data as it didn't end at Columns T and U. So its possible my PC had the issue with running the macro as I tend to have multiple applications running at once.
 
Upvote 0
1. If you have data beyond T & U, did the individual states actually go into column U or did you modify the code to put it in another column?

2. Do you have any/lots of formulas in the sheet?

3. Do you have any other vba code in the workbook?
 
Upvote 0
There are no other VBA codes, and very few formulas. I tried to run the macro again with the raw data and this time I did not get any errors. I think my PC just had a bad night. Thanks again for all the help!
 
Upvote 0

Forum statistics

Threads
1,214,650
Messages
6,120,734
Members
448,987
Latest member
marion_davis

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
Back
Top