EXCEL VBA Insert rows below when Text found within Column

mandylima123

New Member
Joined
Jun 3, 2015
Messages
4
Hello!

I am an absolute beginner in VBA and have struggled to write a MACRO that will help me format a Data Center report that I must complete weekly with thousands of lines. Any help will be so greatly appreciated!!!

In the report, if the text "-C0" (a dash followed by the letter "C" and the number "0") is found in column B in any part of the text, I need to insert 7 lines below, copy the information in all cells of that row (except column D) to the 7 new rows below, and in column D of all 8 rows, put: 1, 2, 3, 4, 5, 6, 7 and 8 in that order. The "-C0" indicates that the device described is a chassis and column D then indicates the 8 blades on each chassis.

Thank you in advance to anyone willing to give this a try! This would be a lifesaver for me!

-Mandy
 
Last edited:

Excel Facts

Quick Sum
Select a range of cells. The total appears in bottom right of Excel screen. Right-click total to add Max, Min, Count, Average.
Hello!

I am an absolute beginner in VBA and have struggled to write a MACRO that will help me format a Data Center report that I must complete weekly with thousands of lines. Any help will be so greatly appreciated!!!

In the report, if the text "-C0" (a dash followed by the letter "C" and the number "0") is found in column B in any part of the text, I need to insert 7 lines below, copy the information in all cells of that row (except column D) to the 7 new rows below, and in column D of all 8 rows, put: 1, 2, 3, 4, 5, 6, 7 and 8 in that order. The "-C0" indicates that the device described is a chassis and column D then indicates the 8 blades on each chassis.

Thank you in advance to anyone willing to give this a try! This would be a lifesaver for me!

-Mandy
What columns specifically do you want copied A:C or just B:C or .....?
 
Upvote 0
Give this macro a try...
Code:
Sub DashCeeZero()
  Dim FirstRow As Long, Rng As Range
  Set Rng = Columns("B").Find("-C0", , xlValues, xlPart, , _
                              xlPrevious, False, , False)
  If Not Rng Is Nothing Then
    FirstRow = Rng.Row
    Application.ScreenUpdating = False
    Do
      Rng.Offset(1).Resize(7).EntireRow.Insert
      Set Rng = Columns("B").Find("-C0", Rng, xlValues, xlPart, , _
                                  xlPrevious, False, , False)
    Loop While Not Rng Is Nothing And Rng.Row < FirstRow
    For Each Rng In Columns("D").SpecialCells(xlBlanks).Areas
      Rng(1).Offset(-1).Resize(8) = [{1;2;3;4;5;6;7;8}]
      Intersect(Rng(1).Offset(-1).EntireRow, Range("A:C")).Copy Rng.Offset(, -3)
      Intersect(Rng(1).Offset(-1).EntireRow, Range("E:M")).Copy Rng.Offset(, 1)
    Next
    Application.ScreenUpdating = True
  End If
End Sub
 
Last edited:
Upvote 0
Give this macro a try...
Code:
Sub DashCeeZero()
  Dim FirstRow As Long, Rng As Range
  Set Rng = Columns("B").Find("-C0", , xlValues, xlPart, , _
                              xlPrevious, False, , False)
  If Not Rng Is Nothing Then
    FirstRow = Rng.Row
    Application.ScreenUpdating = False
    Do
      Rng.Offset(1).Resize(7).EntireRow.Insert
      Set Rng = Columns("B").Find("-C0", Rng, xlValues, xlPart, , _
                                  xlPrevious, False, , False)
    Loop While Not Rng Is Nothing And Rng.Row < FirstRow
    For Each Rng In Columns("D").SpecialCells(xlBlanks).Areas
      Rng(1).Offset(-1).Resize(8) = [{1;2;3;4;5;6;7;8}]
      Intersect(Rng(1).Offset(-1).EntireRow, Range("A:C")).Copy Rng.Offset(, -3)
      Intersect(Rng(1).Offset(-1).EntireRow, Range("E:M")).Copy Rng.Offset(, 1)
    Next
    Application.ScreenUpdating = True
  End If
End Sub
One line shorter...
Code:
Sub DashCeeZero()
  Dim FirstRow As Long, Rng As Range
  Set Rng = Columns("B").Find("-C0", , xlValues, xlPart, , _
                              xlPrevious, False, , False)
  If Not Rng Is Nothing Then
    FirstRow = Rng.Row
    Application.ScreenUpdating = False
    Do
      Rng.Offset(1).Resize(7).EntireRow.Insert
      Set Rng = Columns("B").Find("-C0", Rng, xlValues, xlPart, , _
                                  xlPrevious, False, , False)
    Loop While Not Rng Is Nothing And Rng.Row < FirstRow
    For Each Rng In Columns("D").SpecialCells(xlBlanks).Areas
      Intersect(Rng(1).Offset(-1).EntireRow, Range("A:M")).Copy Rng.Offset(, -3)
      Rng(1).Offset(-1).Resize(8) = [ROW(1:8)]
    Next
    Application.ScreenUpdating = True
  End If
End Sub
 
Upvote 0
Hi Mandy,

Welcome to MrExcel!!

Though Rick's is more efficient, here's my attempt (I'd spent a little on it so I thought I'd post it):

Code:
Option Explicit
Sub Macro1()
    
    Dim lngMyRow As Long
    Dim lngMyCounter As Long
    
    Application.ScreenUpdating = False
       
    For lngMyRow = Range("B" & Rows.Count).End(xlUp).Row To 2 Step -1
        If InStr(Cells(lngMyRow, "B"), "-C0") > 0 Then
            Cells(lngMyRow + 1, "A").Resize(7).EntireRow.Insert
            Range("B" & lngMyRow & ":M" & lngMyRow).Copy Destination:=Range("B" & lngMyRow + 1 & ":M" & lngMyRow + 7)
            lngMyCounter = 1
            Do Until lngMyCounter > 8
                Range("D" & lngMyRow + lngMyCounter - 1).Value = lngMyCounter
                lngMyCounter = lngMyCounter + 1
            Loop
        End If
    Next lngMyRow
    
    Application.ScreenUpdating = True

End Sub

Regards,

Robert
 
Upvote 0
Rick,
Wow! A Thing of Beauty! It really worked. The second Macro seemed to work better for me. I am so very grateful. You have saved about 3 weekly hours for me. Thank you Thank you Thank you!
-Mandy
 
Upvote 0
Thank you Robert! This Macro worked beautifully and I have been inspired to learn more Visual Basic to help me with all the reports with vast amounts of data that seems to cross my desk. You have renewed my faith in coding!
-Mandy
 
Upvote 0
Thank you Robert! This Macro worked beautifully and I have been inspired to learn more Visual Basic to help me with all the reports with vast amounts of data that seems to cross my desk. You have renewed my faith in coding!
-Mandy

Thanks for the feedback and that's good news. I'm glad we were able to provide you with a workable solution :)
 
Upvote 0

Forum statistics

Threads
1,213,484
Messages
6,113,920
Members
448,533
Latest member
thietbibeboiwasaco

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