Solved EXCEL-Insert varies Rows Below Based On Criteria

March 10, 2015 at 08:08:00
Specs: Windows 7
I am new to excel VBA and I sincerely needed a marco which can insert vary no. of rows (base on the no. of "space" in column E), breaking down the code in column E and copy all other rows. (see below input and output)
I have tried to search around but cannot find what i needed.
It is ok to show the result data in sheet 2.
One to note: The marco would be run on excel 2000 (I don't know if whether some codes cannot be execute on excel 2000)


Input:
Title A Title B Title C Title D Title E Title F Title G
Data 1 Data 1 Data 1 Data 1 AAA BBB CCC Data 1 Data 1
Data 2 Data 2 Data 2 Data 2 AAA BBB CCC DDD Data 2 Data 2
…..

Output:
Title A Title B Title C Title D Title E Title F Title G
Data 1 Data 1 Data 1 Data 1 AAA Data 1 Data 1
Data 1 Data 1 Data 1 Data 1 BBB Data 1 Data 1
Data 1 Data 1 Data 1 Data 1 CCC Data 1 Data 1
Data 2 Data 2 Data 2 Data 2 AAA Data 2 Data 2
Data 2 Data 2 Data 2 Data 2 BBB Data 2 Data 2
Data 2 Data 2 Data 2 Data 2 CCC Data 2 Data 2
Data 2 Data 2 Data 2 Data 2 DDD Data 2 Data 2

Thanks for all your great help in advance.

message edited by Andy3yhk


See More: EXCEL-Insert varies Rows Below Based On Criteria

Report •

✔ Best Answer
March 13, 2015 at 10:08:25
Let me start by saying that you should try all of this in a backup copy of your workbook since macros can not be undone.

You didn't include Column Letters or Row Numbers with your example data, so the code below assumes the range begins in A1. The code also assume that your data is in Sheet 1. The code would need to be modified if those assumptions are incorrect.

That said...

I have included 2 macros in this post. The first macro, ReBuildSheet1 will allow you to easily rebuild Sheet 1 after you run the Split_E macro. I'll explain why you might want to do that a little later.

In order for the ReBuildSheet1 to work, you must first copy Sheet1 to Sheet2.

1 - Right-Click the sheet tab for Sheet 1
2 - Choose "Move or Copy"
3 - Click the Sheet 2 entry in the "Before Sheet" list
4 - Check the "Create a copy" box
5 - Click OK

That will create a duplicate copy of Sheet 1 which you can use to rebuild Sheet 1 by running the following macro

Sub ReBuildSheet1()
'Clear Sheet1
 Sheets(1).Cells.ClearContents
'Copy Sheet 2 to Sheet 1
   With Sheets(2)
     lastRw = .Cells(.Rows.Count, "A").End(xlUp).Row
     lastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
        .Range(.Cells(1, 1), .Cells(lastRw, lastCol)).Copy _
          Sheets(1).Cells(1, 1)
   End With
End Sub

OK, based on your example data, I believe the following code does what you asked for with one minor exception. For the time being, instead of replacing the data in Column E with the sub-strings, it places those sub-strings in Column H. There are 2 reasons for that:

1 - The code retains the current strings in Column E to use them to determine which sub-string to place in Column H.

2 - It allows you to review the results to make sure the code is splitting the strings in the manner you want.

In the code, I have included a section that will replace Column E with Column H, but it is currently Commented out so it will not do the replacement. If you are happy with what you see in Column H, then you can run the ReBuildSheet1 macro to get Sheet 1 back to its original layout, then un-comment the 2 instructions at the end of the Split_E code and run it again. This time the "new data" in Column H will be Cut/Pasted into Column E.

Note: If Column H already contains data, you can either change the reference to Column H in the code to another Column letter or insert a Column H for the code to use.

In addition, since you mentioned that you are "new to VBA" you might want to review this How To. It may help you understand how the 2 macros in this post do what they do.

http://www.computing.net/howtos/sho...

Let me know if you have any questions.

Sub Split_E()
 With Sheets(1)
'Determine last cell with data in Column E
  lastRw = .Cells(Rows.Count, "E").End(xlUp).Row
'Loop through Column E
    For SrcRw = lastRw To 2 Step -1
'Count number of spaces in Column E cells
      numSpace = UBound(Split(Cells(SrcRw, "E"), " "))
'Copy/Insert Rows based on Number of spaces
        For newRw = 1 To numSpace
'Set variable for Split Array element
          newData = (numSpace - newRw + 1)
'Place correct Split Array element in Column H
            .Cells(SrcRw, "H") = Split(Cells(SrcRw, "E"), " ")(newData)
'Copy/Paste Row
             .Cells(SrcRw, "E").EntireRow.Copy
             .Cells(SrcRw, "E").EntireRow.Insert shift:=xlDown
        Next
'Fix new data in last Copied cell
      .Cells(SrcRw, "H") = Split(Cells(SrcRw, "E"), " ")(0)
    Next
'Determine last cell with data in Column H, Replace Column E
'**** Uncomment the next 2 lines to replace Column E data
         'lastH_Rw = .Cells(Rows.Count, "H").End(xlUp).Row
         '.Range("H2:H" & lastH_Rw).Cut .Range("$E$2")
 End With
End Sub

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.



#1
March 10, 2015 at 10:25:43
First, a posting tip:

Please click on the blue line at the end of this post and read the instructions on how to format example data so that it is easier for us to read. Then edit/repost your data so that the columns line up correctly. Don't forget to use Column letters and Row numbers as shown in the example.

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.


Report •

#2
March 11, 2015 at 21:11:09
Thanks! Adjusted as follow:

Input:

Title A Title B Title C Title D       Title E           Title F   Title G
Data 1  Data 1  Data 1  Data 1      AAA BBB CCC         Data 1     Data 1 
Data 2  Data 2  Data 2  Data 2     AAA BBB CCC DDD      Data 2     Data 2


Output:
Title A Title B Title C Title D Title E Title F Title G
Data 1  Data 1  Data 1  Data 1   AAA    Data 1   Data 1
Data 1  Data 1  Data 1  Data 1   BBB    Data 1   Data 1
Data 1  Data 1  Data 1  Data 1   CCC    Data 1   Data 1
Data 2  Data 2  Data 2  Data 2   AAA    Data 2   Data 2
Data 2  Data 2  Data 2  Data 2   BBB    Data 2   Data 2
Data 2  Data 2  Data 2  Data 2   CCC    Data 2   Data 2
Data 2  Data 2  Data 2  Data 2   DDD    Data 2   Data 2

message edited by Andy3yhk


Report •

#3
March 12, 2015 at 05:00:53
Is there ever a time when there is only a single entry in a Column E?

Are the groups always separeted by a single space?

Since the VBA code has to be very specific as to how it deals with the data in a Column E, I want to make sure that your actual data is similar to your example data.

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.


Report •

Related Solutions

#4
March 13, 2015 at 02:13:22
Is there ever a time when there is only a single entry in a Column E?
Andy: Yes.

Are the groups always seperated by a single space?
Andy: Yes, and the value is always in 3-digit no.

Thanks!


Report •

#5
March 13, 2015 at 04:15:20
Ok...I've almost got something, just needed that info to finish up. Be back soon.

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.


Report •

#6
March 13, 2015 at 10:08:25
✔ Best Answer
Let me start by saying that you should try all of this in a backup copy of your workbook since macros can not be undone.

You didn't include Column Letters or Row Numbers with your example data, so the code below assumes the range begins in A1. The code also assume that your data is in Sheet 1. The code would need to be modified if those assumptions are incorrect.

That said...

I have included 2 macros in this post. The first macro, ReBuildSheet1 will allow you to easily rebuild Sheet 1 after you run the Split_E macro. I'll explain why you might want to do that a little later.

In order for the ReBuildSheet1 to work, you must first copy Sheet1 to Sheet2.

1 - Right-Click the sheet tab for Sheet 1
2 - Choose "Move or Copy"
3 - Click the Sheet 2 entry in the "Before Sheet" list
4 - Check the "Create a copy" box
5 - Click OK

That will create a duplicate copy of Sheet 1 which you can use to rebuild Sheet 1 by running the following macro

Sub ReBuildSheet1()
'Clear Sheet1
 Sheets(1).Cells.ClearContents
'Copy Sheet 2 to Sheet 1
   With Sheets(2)
     lastRw = .Cells(.Rows.Count, "A").End(xlUp).Row
     lastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
        .Range(.Cells(1, 1), .Cells(lastRw, lastCol)).Copy _
          Sheets(1).Cells(1, 1)
   End With
End Sub

OK, based on your example data, I believe the following code does what you asked for with one minor exception. For the time being, instead of replacing the data in Column E with the sub-strings, it places those sub-strings in Column H. There are 2 reasons for that:

1 - The code retains the current strings in Column E to use them to determine which sub-string to place in Column H.

2 - It allows you to review the results to make sure the code is splitting the strings in the manner you want.

In the code, I have included a section that will replace Column E with Column H, but it is currently Commented out so it will not do the replacement. If you are happy with what you see in Column H, then you can run the ReBuildSheet1 macro to get Sheet 1 back to its original layout, then un-comment the 2 instructions at the end of the Split_E code and run it again. This time the "new data" in Column H will be Cut/Pasted into Column E.

Note: If Column H already contains data, you can either change the reference to Column H in the code to another Column letter or insert a Column H for the code to use.

In addition, since you mentioned that you are "new to VBA" you might want to review this How To. It may help you understand how the 2 macros in this post do what they do.

http://www.computing.net/howtos/sho...

Let me know if you have any questions.

Sub Split_E()
 With Sheets(1)
'Determine last cell with data in Column E
  lastRw = .Cells(Rows.Count, "E").End(xlUp).Row
'Loop through Column E
    For SrcRw = lastRw To 2 Step -1
'Count number of spaces in Column E cells
      numSpace = UBound(Split(Cells(SrcRw, "E"), " "))
'Copy/Insert Rows based on Number of spaces
        For newRw = 1 To numSpace
'Set variable for Split Array element
          newData = (numSpace - newRw + 1)
'Place correct Split Array element in Column H
            .Cells(SrcRw, "H") = Split(Cells(SrcRw, "E"), " ")(newData)
'Copy/Paste Row
             .Cells(SrcRw, "E").EntireRow.Copy
             .Cells(SrcRw, "E").EntireRow.Insert shift:=xlDown
        Next
'Fix new data in last Copied cell
      .Cells(SrcRw, "H") = Split(Cells(SrcRw, "E"), " ")(0)
    Next
'Determine last cell with data in Column H, Replace Column E
'**** Uncomment the next 2 lines to replace Column E data
         'lastH_Rw = .Cells(Rows.Count, "H").End(xlUp).Row
         '.Range("H2:H" & lastH_Rw).Cut .Range("$E$2")
 End With
End Sub

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.


Report •

#7
March 17, 2015 at 01:13:30
Sorry I was out for these days, I am trying the marco now. Will update you soon!

[Update] - It works perfectly. Also thanks for the detail comments so that can learn the code too!

message edited by Andy3yhk


Report •

Ask Question