Help with Inserting Multiple Data Rows (same data) after change in Value Occurs

[Dinah]

Hello,

I am trying to create a VBA statement in which 5 rows with data are input between values. The first and last of these should be gray if possible and the text will be in the middle 3 rows. For example:


Before:
COLUMN A COLUMN B
STATION REGION
5A TRO
5A TRO
5A TRO
5B TRO
5B TRO



End Result:
COLUMN A COLUMN B
STATION REGION
5A TRO
5A TRO
5A TRO
BLANK LINE COLORED GRAY
OBSERVATIONS
VIOLATIONS
TOTAL
BLANK LINE COLORED GRAY
5B TRO
5B TRO
BLANK LINE COLORED GRAY
OBSERVATIONS
VIOLATIONS
TOTAL
BLANK LINE COLORED GRAY

 

[hiker95]

Dinah,

Welcome to the MrExcel forum.


Sample raw data:

Excel Workbook
	A	B
1	STATION	REGION
2	5A	TRO
3	5A	TRO
4	5A	TRO
5	5B	TRO
6	5B	TRO
7
8
9
10
11
12
13
14
15
16
17
Sheet1

After the macro:

Excel Workbook
	A	B
1	STATION	REGION
2	5A	TRO
3	5A	TRO
4	5A	TRO
5
6	OBSERVATIONS
7	VIOLATIONS
8	TOTAL
9
10	5B	TRO
11	5B	TRO
12
13	OBSERVATIONS
14	VIOLATIONS
15	TOTAL
16
17
Sheet1

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

1. Copy the below code, by highlighting the code and pressing the keys CTRL + C
2. Open your workbook
3. Press the keys ALT + F11 to open the Visual Basic Editor
4. Press the keys ALT + I to activate the Insert menu
5. Press M to insert a Standard Module
6. Where the cursor is flashing, paste the code by pressing the keys CTRL + V
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel, open the workbook, and press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.

Option Explicit
Sub InsertBetween()
' hiker95, 09/17/2012
' http://www.mrexcel.com/forum/excel-questions/659755-help-inserting-multiple-data-rows-same-data-after-change-value-occurs.html
Dim r As Long, lr As Long, i
Application.ScreenUpdating = False
i = Array("", "OBSERVATIONS", "VIOLATIONS", "TOTAL", "")
lr = Cells(Rows.Count, 1).End(xlUp).Row + 1
For r = lr To 3 Step -1
  If Cells(r, 1) <> Cells(r - 1, 1) Then
    Rows(r).Resize(5).Insert
    Cells(r, 1).Resize(5).Value = Application.Transpose(i)
    Cells(r, 1).Resize(, 2).Interior.ColorIndex = 15
    Cells(r + 4, 1).Resize(, 2).Interior.ColorIndex = 15
  End If
Next r
Columns(1).AutoFit
Application.ScreenUpdating = True
End Sub

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm


Then run the InsertBetween macro.

 

[Dinah]

Hiker95,

You made my day! Thank you so much for that. I meant to include a code I had put in that wasn't working. I'm a novice! If you have the time would you mind explaining the code? I was unsure of how to create text in the same column that would populate directly beneath (e.g. 'observations', 'violations' not being in the same cell, column A). Also, how did you know how to code the color as 15?

Thank you so very much,
Dinah

 

[Dinah]

Hiker95,

Sorry - is there a way to make the words in the array Bold?

Thank you,
Dinah

 

[hiker95]

Dinah,


Working with the same raw data worksheet screenshot above.


After the updated macro:

Excel Workbook
	A	B
1	STATION	REGION
2	5A	TRO
3	5A	TRO
4	5A	TRO
5
6	OBSERVATIONS
7	VIOLATIONS
8	TOTAL
9
10	5B	TRO
11	5B	TRO
12
13	OBSERVATIONS
14	VIOLATIONS
15	TOTAL
16
17
Sheet1

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

1. Copy the below code, by highlighting the code and pressing the keys CTRL + C
2. Open your workbook
3. Press the keys ALT + F11 to open the Visual Basic Editor
4. Press the keys ALT + I to activate the Insert menu
5. Press M to insert a Standard Module
6. Where the cursor is flashing, paste the code by pressing the keys CTRL + V
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel, open the workbook, and press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.

Option Explicit
Sub InsertBetweenV2()
' hiker95, 09/18/2012
' http://www.mrexcel.com/forum/excel-questions/659755-help-inserting-multiple-data-rows-same-data-after-change-value-occurs.html
Dim r As Long, lr As Long, i
Application.ScreenUpdating = False
i = Array("", "OBSERVATIONS", "VIOLATIONS", "TOTAL", "")
lr = Cells(Rows.Count, 1).End(xlUp).Row + 1
For r = lr To 3 Step -1
  If Cells(r, 1) <> Cells(r - 1, 1) Then
    Rows(r).Resize(5).Insert
    Cells(r, 1).Resize(5).Value = Application.Transpose(i)
    Cells(r, 1).Resize(, 2).Interior.ColorIndex = 15
    Cells(r + 1, 1).Resize(3).Font.Bold = True
    Cells(r + 4, 1).Resize(, 2).Interior.ColorIndex = 15
  End If
Next r
Columns(1).AutoFit
Application.ScreenUpdating = True
End Sub

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm


Then run the InsertBetweenV2 macro.

 

[hiker95]

Dinah,

Also, how did you know how to code the color as 15?

You did not tell us what version of Excel you were using. So, I created the macro with Excel 2003, and picked the color as 15 from the color pallet in formatting.

If you are using a different version of Excel, then it could make a difference.

If you have the time would you mind explaining the code?

Will be back later.

I'm a novice!

See the link below.

Training / Books / Sites as of 09/13/2012
http://www.mrexcel.com/forum/excel-...gathering-suggestions-please.html#post3250542

 

[hiker95]

Dinah,

If you have the time would you mind explaining the code?

See below in BOLD the first pass of the macro.

Option Explicit
Sub InsertBetweenV2()
' hiker95, 09/18/2012
' http://www.mrexcel.com/forum/excel-questions/659755-help-inserting-multiple-data-rows-same-data-after-change-value-occurs.html

' r is a counter
' lr is the lastrow
' i is an array to hold the inserted text
Dim r As Long, lr As Long, i

' turn screen updatting OFF
Application.ScreenUpdating = False

' initialize the i array
i = Array("", "OBSERVATIONS", "VIOLATIONS", "TOTAL", "")

' find the last used row in column "A" and add one to lr
lr = Cells(Rows.Count, 1).End(xlUp).Row + 1

' when inserting/deleting rows it is good practice to start from the bottom and go up
' loop from one cell down from the last cell in column A to row 3
' the "Step - 1" means loop in reverse down to up
For r = lr To 3 Step -1

  ' if cell A7 is not equal to cell A6 then
  If Cells(r, 1) <> Cells(r - 1, 1) Then
    
    ' at cell A7 insert 5 blank rows
    Rows(r).Resize(5).Insert
    
    ' transpose the i ary at A7
    Cells(r, 1).Resize(5).Value = Application.Transpose(i)
    
    ' the first inserted row is blank and its interior color should be GRAY
    Cells(r, 1).Resize(, 2).Interior.ColorIndex = 15
    
    ' in the five inserted rows, the three rows with the inserted text,
    '   row 2 thru row 4 should have the text as BOLD
    Cells(r + 1, 1).Resize(3).Font.Bold = True
    
    ' the last of the five inserted rows is blank and its interior color should be GRAY
    Cells(r + 4, 1).Resize(, 2).Interior.ColorIndex = 15
  End If
Next r

' auto fit column A the the widest text string added
Columns(1).AutoFit

' turn screen updatting back ON
Application.ScreenUpdating = True
End Sub

 

[Dinah]

hiker95,

Wow, this is absolutely wonderful. You have really helped me out. With the explanation I was able to add one more row of bold text and move the gray line down one. Thanks a million.

I have an additional task I'd like to do. I'll post it below but if you're busy I can repost to the public. If you could get me started I could take a stab at completing similar vba.

I have my new spreadsheet which now has the inserted rows: OBS, VIOL, VIOL RATE and STATEMENT. (Please forgive me as I'm not able to download anything external to upload an image at my workplace) I'm trying to automatically populate three Columns (Ph, DO and Enterocci) with a formula. For example:


Station pH
5ABLW000.30 7.2
5ABLW000.30 6.2

Observations =COUNT(Z2:Z3) *Count number of occurences until change of value / station)*
Viol =SUM(COUNTIF(Z2:Z3,"<6"),COUNTIF(Z2:Z3,">9")) *Sum of all less than 6 and greater than 9 , account for all until change of station*
Viol Rate =(Z6/Z5)*100 *Viol/Observations x 100 for percentage outcome*

I want to be able to have this loop through each station and input this information. I have to enter similar info for two other columns but I think i can figure it out if I have one set of vba code. I was assuming this was better if kept separate from the original code you provided. Any help you could offer would be great. If not please let me know i'll repost.

Thank you hiker95!
dinah
[TABLE="width: 404"]
<TBODY>[TR]
[TD] </SPAN>[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[/TR]
[TR]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[/TR]
</TBODY><COLGROUP><COL><COL span=2><COL></COLGROUP>[/TABLE]

 

[Dinah]

Sorry that example should have two columns - Station and pH (the pH values are 7.2 and 6.2). Wish i had a work around for downloading image software at work.

 

[hiker95]

Dinah,

I have an additional task I'd like to do. I'll post it below but if you're busy I can repost to the public. If you could get me started I could take a stab at completing similar vba.

I have my new spreadsheet which now has the inserted rows: OBS, VIOL, VIOL RATE and STATEMENT. (Please forgive me as I'm not able to download anything external to upload an image at my workplace) I'm trying to automatically populate three Columns (Ph, DO and Enterocci) with a formula.

You can upload your workbook to Box Net,

sensitive data scrubbed/removed/changed

mark the workbook for sharing
and provide us with a link to your workbook.