Inserting rows under found cell

[TotalNoob122]

Hello everyone,

I'm having some issues making a macro that would save me a lot of time and I need your help...

I was trying to:

1. look for a string of text in a cell.
2. Add 4 rows with content under said cell.

It looks simple but I've been trying the Find command and has two limitations:

• You have to start from finish to start, if not the position of the others cells change.
• You have to detect when you reach the first found cell or the loop would never end.

EXAMPLE:

I HAVE THIS:

AND I WOULD LIKE TO ADD THIS:

At the moment all I got is this :

Sub FindNext_Example()



Dim FindValue As String

FindValue = "CCC"



Dim Rng As Range

Set Rng = Range("A2:A111")



Dim FindRng As Range

Set FindRng = Rng.Find(What:=FindValue, LookIn:= _

xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _

xlNext, MatchCase:=False, SearchFormat:=False)




Dim FirstCell As String

FirstCell = FindRng.Address



Do

Rng.Select

Application.Goto FindRng



ActiveCell.Offset(1, 0).EntireRow.Insert Shift:=xlShiftDown

ActiveCell.Offset(1).EntireRow.Insert Shift:=xlShiftDown

ActiveCell.Offset(1).EntireRow.Insert Shift:=xlShiftDown

ActiveCell.Offset(1).EntireRow.Insert Shift:=xlShiftDown
¡



ActiveCell.Offset(1, 0).Range("A1").Select

ActiveCell.FormulaR1C1 = "POTATOES"

ActiveCell.Font.Color = RGB(0, 0, 0)

ActiveCell.Offset(1, 0).Range("A1").Select

ActiveCell.FormulaR1C1 = "LEMONADE"

ActiveCell.Font.Color = RGB(0, 0, 0)

ActiveCell.Offset(1, 0).Range("A1").Select

ActiveCell.FormulaR1C1 = "ORANGES."

ActiveCell.Font.Color = RGB(0, 0, 0)

ActiveCell.Offset(1, 0).Range("A1").Select

ActiveCell.FormulaR1C1 = "SPINACH"

ActiveCell.Font.Color = RGB(0, 0, 0)



Set FindRng = Rng.FindNext(FindRng)


Loop While FirstCell <> FindRng.Address



MsgBox "Search is over"



End Sub

I would really appreciate your help guys,

Thanks

 

[Joe4]

Welcome to the Board!

The issue when inserting or deleting rows is that it moves the range that you have yet to evaluate, and that can cause issues and cause things to get missed or duplicated.
For that reason, whenever you are inserting or deleting rows, it is usually best to loop through the range backwards, so you aren't affecting the size of the range you have not evaluated yet.

If your starting range was A2:A111, you can go through each row backwards and evaluate it.
So, the structure of your code would look something like this:

Dim r as Long

'Loop through rows 2:111 backwards
For r = 111 to 2 Step -1
'   Check the value in column A of this row
    If Cells(r, "A")= "CCC" Then
    ...


Next r

 

[TotalNoob122]

Welcome to the Board!

The issue when inserting or deleting rows is that it moves the range that you have yet to evaluate, and that can cause issues and cause things to get missed or duplicated.
For that reason, whenever you are inserting or deleting rows, it is usually best to loop through the range backwards, so you aren't affecting the size of the range you have not evaluated yet.

If your starting range was A2:A111, you can go through each row backwards and evaluate it.
So, the structure of your code would look something like this:

Dim r as Long

'Loop through rows 2:111 backwards
For r = 111 to 2 Step -1
'   Check the value in column A of this row
    If Cells(r, "A")= "CCC" Then
    ...


Next r

Hello Joe, it's a pleasure to join this community.

i'm getting started in VBA and programming is not my field so all of this is really new to me.
I have a question: If Cells(r, "A")= "CCC" Then doesn't look only for the cell to have just CCC? If my cell is named AACCCCAA would also find it?
I appreciate your reply but I'm pretty burned trying this to work (I have spent days) and all I'm getting is errors...
Could you please post the full code? It certainly would help others too.

Sorry for the inconvenience and once again, thanks for the support!

 

[Joe4]

I have a question: If Cells(r, "A")= "CCC" Then doesn't look only for the cell to have just CCC? If my cell is named AACCCCAA would also find it?

You did not mention that in your original post/examples.

See if this does what you want:

Sub MyFindValues()

    Dim lr As Long
    Dim r As Long
    Dim FindValue As String
    Dim arr()
    Dim i As Long
    
'   Designate value to find
    FindValue = "CCC"
    
'   Set array of values to insert
    arr = Array("Potatoes", "Lemonade", "Oranges", "Spinach")
    
    Application.ScreenUpdating = False
    
'   Find last row in column A with data
    lr = Cells(Rows.Count, "A").End(xlUp).Row
    
'   Loop through all rows backwards
    For r = lr To 2 Step -1
'       Check to see if FundValue found ANYWHERE in string in column A
        If InStr(Cells(r, "A"), FindValue) > 0 Then
'           Insert four rows
            Rows(r + 1 & ":" & r + 4).Insert
'           Loop through array to populate inserted rows
            For i = LBound(arr) To UBound(arr)
                Cells(r + 1 + i, "A").Value = arr(i)
            Next i
        End If
    Next r

    Application.ScreenUpdating = True

End Sub

 

[TotalNoob122]

You did not mention that in your original post/examples.

See if this does what you want:

Sub MyFindValues()

    Dim lr As Long
    Dim r As Long
    Dim FindValue As String
    Dim arr()
    Dim i As Long
   
'   Designate value to find
    FindValue = "CCC"
   
'   Set array of values to insert
    arr = Array("Potatoes", "Lemonade", "Oranges", "Spinach")
   
    Application.ScreenUpdating = False
   
'   Find last row in column A with data
    lr = Cells(Rows.Count, "A").End(xlUp).Row
   
'   Loop through all rows backwards
    For r = lr To 2 Step -1
'       Check to see if FundValue found ANYWHERE in string in column A
        If InStr(Cells(r, "A"), FindValue) > 0 Then
'           Insert four rows
            Rows(r + 1 & ":" & r + 4).Insert
'           Loop through array to populate inserted rows
            For i = LBound(arr) To UBound(arr)
                Cells(r + 1 + i, "A").Value = arr(i)
            Next i
        End If
    Next r

    Application.ScreenUpdating = True

End Sub

Thank you so much!

Sorry for not being 100% clear , tried your code and work like a charm!
Could you recommend me some source to learn more? Is there some book you would recommend?

Thanks again! Really appreciate it!

 

[Joe4]

You are welcome!

The book I used to learn is well out-dated (over 20 years old), but there are lots of good resources out there.
MrExcel publishing has a whole series of books on VBA. See: Products
Also, there are lots of on-line tutorials and YouTube videos that you can fund with Google/YouTube seraches.
And of course, you can learn a lot not just by asking, but also reading other threads on this forum.

 

[TotalNoob122]

You are welcome!

The book I used to learn is well out-dated (over 20 years old), but there are lots of good resources out there.
MrExcel publishing has a whole series of books on VBA. See: Products
Also, there are lots of on-line tutorials and YouTube videos that you can fund with Google/YouTube seraches.
And of course, you can learn a lot not just by asking, but also reading other threads on this forum.

Will take a look, thanks!