Macro To Insert Rows

[Sand359]

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

 

[alansidman]

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

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

 

[Sand359]

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:

[TABLE="class: grid, width: 50"]
<tbody>[TR]
[TD][/TD]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[TD]D[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]Invoice[/TD]
[TD]Contact[/TD]
[TD]States[/TD]
[TD]State
[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]123456[/TD]
[TD]John Smith[/TD]
[TD]*AK*AR*CO*LA[/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

To This:
[TABLE="class: grid, width: 50"]
<tbody>[TR]
[TD][/TD]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[TD]D[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]Invoice[/TD]
[TD]Contact[/TD]
[TD]States[/TD]
[TD]State[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]123456[/TD]
[TD]John Smith[/TD]
[TD]*AK*AR*CO*LA[/TD]
[TD]*AK[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]123456[/TD]
[TD]John Smith[/TD]
[TD]*AK*AR*CO*LA[/TD]
[TD]*AR[/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD]123456[/TD]
[TD]John Smith[/TD]
[TD]*AK*AR*CO*LA[/TD]
[TD]*CO[/TD]
[/TR]
[TR]
[TD]5[/TD]
[TD]123456[/TD]
[TD]John Smith[/TD]
[TD]*AK*AR*CO*LA[/TD]
[TD]*LA[/TD]
[/TR]
</tbody>[/TABLE]

 

[Peter_SSs]

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.

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

 

[Sand359]

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

 

[Peter_SSs]

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.

 

[Sand359]

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.

 

[Peter_SSs]

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?

 

[Sand359]

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!

 

[Peter_SSs]

OK, thanks for that. I can rest easier now.