Inserting 2 rows if a cell meets certain criteria|VBA & Macros|Excel Forum|My Online Training Hub

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

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