Insert a blank row in between 2 values

[ceclay]

I have a random list on column "A". What I would like to do is to insert a row if value below "Bills Payment" is "Payment code". Result sample is in Column "C" ut I would like it in Column A.

Book2
	A	B	C
1	Bills Payment:		Bills Payment:
2	Payment Code: 748494
3	Butter		Payment Code: 748494
4	Gardenia		Butter
5	600		Gardenia
6	Bread		600
7	Butter		Bread
8	Cookies		Butter
9	Bills Payment:		Cookies
10	Payment Code: 89721		Bills Payment:
11	700
12	500		Payment Code: 89721
13	Tasty		700
14	Gardenia		500
15	Butter		Tasty
16	Bills Payment:		Gardenia
17	Lay info: 124364		Butter
18	Payment Code: 89721		Bills Payment:
19	700		Lay info: 124364
20	800		Payment Code: 89721
21	Absolute		700
22	Enfamil		800
23			Absolute
24			Enfamil
Sheet1

Sub Click()



Dim Sh As Worksheet

Dim currentValue As String

Dim previousValue As String





Set Sh = Sheets("Sheet2")



With Sh

'For each cell in the column

For i = 1 To .Cells(.Rows.Count, A).End(xlUp).Row

currentValue = "Bills Payment:"

previousValue = .Range(yourColumn & i).Offset(2, 0).Value



If previousValue = "Payment code:*" Then

.Rows(i).EntireRow.Insert Shift:=xlDown

End If

Next i

End With



End Sub

 

[Peter_SSs]

See if this does what you want. Test with a copy of your data.
Code assumes the relevant sheet is the active sheet.

Sub InsertRows()
  Dim i As Long
 
  Application.ScreenUpdating = False
  For i = Range("A" & Rows.Count).End(xlUp).Row To 2 Step -1
    If Left(Range("A" & i).Value, 13) = "Payment Code:" And Range("A" & i - 1).Value = "Bills Payment:" Then Rows(i).Insert
  Next i
  Application.ScreenUpdating = True
End Sub

 

[EXCEL MAX]

Suppose insertings rows meaning after each row with "Bills Payment:".

Sub Click()

    Dim Sh As Worksheet

    Application.ScreenUpdating = False
    Set Sh = Sheets("Sheet2")
    With Sh
        For Each vc In .Range("A1", Cells(Rows.Count, "A").End(xlUp))
            If vc.Value = "Bills Payment:" Then
                .Rows(vc.Row + 1).EntireRow.Insert
            End If
        Next vc
    End With
    Application.ScreenUpdating = True

End Sub

 

[Peter_SSs]

Suppose insertings rows meaning after each row with "Bills Payment:".

Not quite.

It is explained in post 1

insert a row if value below "Bills Payment" is "Payment code"

.. and also has expected results shown

Result sample is in Column "C"

(BTW, your code will error if Sheet2 is not the active sheet.)

 

[EXCEL MAX]

Sorry, my mistake. I didn't read post very well.

 

[Alex Blakenburg]

If you have a lot of data in it really is all just in Column A and formatting is not an issue then this might be an option for you.

Sub testInsertArray()

    Dim sht As Worksheet
    Dim rng As Range
    Dim arr As Variant
    Dim arrOut() As Variant
    Dim PymtCnt As Long, i As Long, cntRow As Long
    
    Set sht = Worksheets("Sheet1")
    Set rng = sht.Range(Cells(1, "A"), Cells(Rows.Count, "A").End(xlUp))
    arr = rng.Value2
    PymtCnt = Application.CountIfs(rng, "Payment Code*")
    
    If PymtCnt = 0 Then Exit Sub
    ReDim arrOut(1 To UBound(arr) + PymtCnt, 1 To 1)
    cntRow = 0
    
    For i = 1 To UBound(arr)
        cntRow = cntRow + 1
        If i <> 1 Then
            If Left(arr(i - 1, 1), 14) = "Bills Payment:" And Left(arr(i, 1), 13) = "Payment Code:" Then
                cntRow = cntRow + 1             ' Skip 1 row
                arrOut(cntRow, 1) = arr(i, 1)
            Else
                arrOut(cntRow, 1) = arr(i, 1)
            End If
        Else
            arrOut(cntRow, 1) = arr(i, 1)
        End If
    Next i
    
    rng.Resize(cntRow).Value = arrOut

End Sub

 

[ceclay]

Thank you everyone! @Peter_SSs codes worked!

 

[Peter_SSs]

You're welcome. Glad we could help. Thanks for the follow-up.