Hello,

Without changing your code, I just made a change (highlighted in red)

this is what you want?

Sub GSRowsAdd()

Dim r As Range
Dim I As Long

I = 6

Do While Range("A" & I).Value <> ""
     If Left(Range("A" & I), 2) = "GS" Then
          I = I + 1
          Rows(I & ":" & I + 1).Insert
     End If
     I = I + 1
Loop

End Sub

 

Regards,

Miguel

Hi,

Thanks for the response.

I've tried the code and it enters the first 2 rows but then does not carry on moving down the list to the next instance where it finds "GS", but seems to start again at the beginning of the list again.

Regards

Martin

Hello,

sorry for the late reply

here are several ways to get what you want, I will leave a simple example

(solution 1)

Option Explicit

Private Sub CommandButton1_Click()

Application.ThisWorkbook.Worksheets("Sheet1").Activate

Dim x As Integer
Dim str As String

str = "GS"

Application.ScreenUpdating = False
For x = Cells(Rows.Count, "A").End(xlUp).Row To 6 Step -1
     If Left(Cells(x, "A"), 2) = str Then
          Cells(x + 1, "A").EntireRow.Insert
          Cells(x + 1, "A").EntireRow.Insert
     End If
Next x
Application.ScreenUpdating = True

End Sub

(solution 2) another example, more complex

Private Sub CommandButton3_Click()

Application.ThisWorkbook.Worksheets("Sheet1").Activate

Dim x As Range
Dim str As String
Dim ArrInput() As Integer, i As Integer, a As Integer
Dim j As Long
Dim sht As Worksheet

Set sht = ActiveSheet

str = "GS"
i = 0

On Error Resume Next
ReDim ArrInput(0)
On Error GoTo 0

For Each x In Range(sht.[A6], sht.[A100].End(xlUp))
      If Left(x, 2) = str Then
           ArrInput(i) = x.Cells.Row
           i = i + 1
           ReDim Preserve ArrInput(i)
      End If
Next x

If i > 0 Then
      Call ArrayInverted(ArrInput)
     For j = LBound(ArrInput) To UBound(ArrInput)
          a = ArrInput(j)
          Debug.Print a
          If a <> 0 Then
               On Error Resume Next
               sht.Range("A" & a + 1 & ":" & "A" & (a + 2)).EntireRow.Insert
               On Error GoTo 0
          Else
               ' Cancel is true
          End If
     Next j
End If

End Sub

Public Sub ArrayInverted(originalArray As Variant)

Dim ArrOutput As Variant
Dim x As Long, endArray As Long, iniArray As Long

endArray = UBound(originalArray)
iniArray = (UBound(originalArray) - LBound(originalArray)) 2 + LBound(originalArray)

For x = LBound(originalArray) To iniArray
     ArrOutput = originalArray(endArray)
     originalArray(endArray) = originalArray(x)
     originalArray(x) = ArrOutput
     endArray = endArray - 1
Next x

End Sub

is it something like what you want? if it needs to be different or adapted, you'd better upload a file with only test data, it would be easier

 

Regards,

Miguel

While using the code you provided, try this out.  Changes I've made are in Red.

Dim r As Range
Dim l As Long

l = 6

Do While Range("A" & l).Value <> ""
     If Left(Range("A" & l), 2) = "GS" Then
     l = l + 1
     Rows(l & ":" & l + 1).Insert
     l = l + 1
End If

l = l + 1
Loop

 

Ken

Many thanks for the responses Miguel and Kenneth, and both solutions have worked well thank you.

Regards

Martin