Loop Question / Problem

[mrowe]

Hi,

Can't seem to get this working. Here's the logic.

Select Collumn A
Find "ATTR"
Select
Insert Line above Selection
Find Next "ATTR"

Loop untill no ATTR in collumn A

Thanks in advance

 

[HalfAce]

Hello mrowe,
Something like this work for you?

Sub InsertRows()
Dim LstRw As Long
Dim c As Object
Dim FirstAddress As String
LstRw = Cells(Rows.Count, "A").End(xlUp).Row

With Sheets("Sheet2").Range("A1:A" & LstRw)
  Set c = .Find(What:="ATTR", LookIn:=xlValues, lookat:=xlWhole)
  If c Is Nothing Then
    MsgBox ("'ATTR' not found in column A.")
  Else
    FirstAddress = c(2).Address
    Do
      c.EntireRow.Insert
      Set c = .FindNext(c)
    Loop While c.Address <> FirstAddress
  End If
End With
End Sub