Read Column A, insert rows based on pattern - excel

Question

I have data in Column A that looks like this:
A
B
A
B
B
B
A
B
A
B
Some points:
All A's must have at least one B. All A's have a B, all B's have an A. (it's an accounting system - it requires this).
Any A can have as many B's as needed.
After each A.B[n] combo, we need a C.
The C must be an inserted row. Sorting and Filtering is not allowed (A, B, and C are variables that aren't replaced with alphabetical characters like seen here).
The code should not insert a C above the first A.
Expected output:
A
B
C
A
B
B
B
C
A
B
C
A
B
C
I've already looked at this: Excel: Insert new line every x rows with content according to a pattern
but the pattern is based on a known 27-line insertion. This has no guaranteed pattern in my problem.

Answer 1

Being a forward thinker, I used multiple Do loops.
Sub InsertCs()
Application.ScreenUpdating = False
Const A As String = "A", B As String = "B", C As String = "C"
Dim r As Long, r2 As Long
With Worksheets("Sheet1")
Do
r = r + 1
If .Cells(r, "A").Value = A And .Cells(r, "A").Offset(1).Value = B Then
r2 = r + 1
Do
r2 = r2 + 1
Loop Until Cells(r2, "A").Value = "" Or Cells(r2, "A").Value = A Or Cells(r2, "A").Value = C
If Not Cells(r2).Value = C Then
.Rows(r2).Insert xlDown
.Cells(r2, "A").Value = C
End If
r = r2
End If
Loop Until Cells(r, "A").Value = ""
End With
End Sub

Answer 2

Try
Sub test()
Dim vDB, vR()
Dim A, B, C
Dim i As Long, r As Long, n As Long
A = "A"
B = "B"
C = "C"
vDB = Range("a1").CurrentRegion
r = UBound(vDB, 1)
n = 1
ReDim Preserve vR(1 To n)
vR(1) = vDB(1, 1)
For i = 2 To r
If vDB(i - 1, 1) = B And vDB(i, 1) = A Then
n = n + 1
ReDim Preserve vR(1 To n)
vR(n) = C
End If
n = n + 1
ReDim Preserve vR(1 To n)
vR(n) = vDB(i, 1)
Next i
If vR(n) = B Then
n = n + 1
ReDim Preserve vR(1 To n)
vR(n) = C
End If
Range("c1").CurrentRegion.Clear
Range("c1").Resize(n, 1) = WorksheetFunction.Transpose(vR)
End Sub
If you want multi column then
Sub test2()
Dim vDB, vR(), vS()
Dim A, B, C
Dim i As Long, r As Long, n As Long
Dim col As Integer
Dim Ws As Worksheet
A = "A"
B = "B"
C = "C"
vDB = Range("a1").CurrentRegion
r = UBound(vDB, 1)
col = UBound(vDB, 2)
n = 1
ReDim Preserve vR(1 To col, 1 To n)
For j = 1 To col
vR(j, n) = vDB(1, j)
Next j
For i = 2 To r
If vDB(i - 1, 1) = B And vDB(i, 1) = A Then
n = n + 1
ReDim Preserve vR(1 To col, 1 To n)
vR(1, n) = C
End If
n = n + 1
ReDim Preserve vR(1 To col, 1 To n)
For j = 1 To col
vR(j, n) = vDB(i, j)
Next j
Next i
If vR(1, n) = B Then
n = n + 1
ReDim Preserve vR(1 To col, 1 To n)
vR(1, n) = C
End If
Set Ws = Sheets.Add 'Sheets("Result")
With Ws
.Range("a1").CurrentRegion.Clear
.Range("a1").Resize(n, col) = WorksheetFunction.Transpose(vR)
End With
End Sub

Answer 3

1. All A's must have at least one B.
Since all A's must have at least one B, your logic seems to boil down to: If current cell is not B and cell directly above is B then insert row and paste C.
Option Explicit
Sub Macro1()
Dim i As Long
Dim a As Variant, b As Variant, c As Variant
a = "A"
b = "B"
c = "C"
With Worksheets("sheet3")
For i = .Cells(.Rows.Count, "A").End(xlUp).Row + 1 To 3 Step -1
Select Case .Cells(i - 1, "A").Value2
Case b
If .Cells(i, "A").Value2 <> b Then
.Rows(i).Insert
.Cells(i, "A") = c
End If
End Select
Next i
End With
End Sub

Answer 4

Sub MultipleSearch()
Dim rng As Range
Dim cll As Range
Dim lrow As Long
lrow = Cells(Rows.Count, 1).End(xlUp).Row
Set rng = Range("A1:A" & lrow)
Cells(lrow + 1, 1) = "C"
For i = rng.Cells.Count To 2 Step -1
If rng.Item(i) = "A" Then
Rows(i).Insert
Cells(i, 1) = "C"
End If
Next
End Sub

Answer 5

Try this simple code. It will loop from the last cell in column A and if there is a variable varA then varB, it will insert a row and add varC. Assign your variables as needed.
Dim varA As Variant, varB As Variant, varC As Variant
Dim Rng As Range, i As Long, lRow As Long
varA = "A"
varB = "B"
varC = "C"
lRow = Cells(Rows.Count, 1).End(xlUp).Row
For i = lRow To 2 Step -1
If Cells(i, 1).Value = varB And Cells(i, 1).Offset(-1).Value = varA Then
Cells(i, 1).Offset(1).EntireRow.Insert
Cells(i, 1).Offset(1).Value = varC
End If
Next i

Answer 6

Using Find and some do loops is a way to do it...
Sub InsertC()
Application.ScreenUpdating = False
Dim Data As Range: Set Data = Worksheets("Sheet1").Range("A:A")
Dim FirstCell As Range: Set FirstCell = Data.Find("A", LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlNext, SearchOrder:=xlByRows)
Dim NextCell As Range, ACell As Range: Set ACell = FirstCell
If Not ACell Is Nothing Then
Do
Set NextCell = ACell
Do While NextCell.Offset(1, 0) = "B"
Set NextCell = NextCell.Offset(1, 0)
Loop
If Not ACell = NextCell Then
NextCell.Offset(1, 0).Insert Shift:=xlDown
NextCell.Offset(1, 0) = "C"
End If
Set ACell = Data.Find("A", After:=NextCell, LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlNext, SearchOrder:=xlByRows)
Loop While ACell.Address <> FirstCell.Address
End If
Application.ScreenUpdating = True
End Sub