Excel Macro - Remove rows and then relabel a cell value - vba

Question

What I'm trying to do is remove any rows where a cell value in a specific column matches what is defined to remove. After that is done re-sequence the value in another column by group.
Using the example below:
I want to look at column B and remove any rows that have a value of A or C. Then I want to basically renumber after the dot (.) in column A to reset itself.
Before Macro Code Fig. 1
After value A and C are removed Fig. 2
Final list after column A is renumbered Fig. 3
I figured out how to remove the rows using this code, but stuck on what to do next:
Sub DeleteRowBasedOnCriteriga()
Dim RowToTest As Long
For RowToTest = Cells(Rows.Count, 2).End(xlUp).Row To 2 Step -1
With Cells(RowToTest, 2)
If .Value = "A" Or .Value = "C" _
Then _
Rows(RowToTest).EntireRow.Delete
End With
Next RowToTest
End Sub

Answer 1

This will be easier to do looping from the top down (using step 1 instead of step -1). I've tried to stay true to your original coding and made this:
Sub DeleteRowBasedOnCriteriga()
Dim RowToTest As Long
Dim startRow As Long
Dim i As Integer
startRow = 2
'Clear the rows that have "A" or "C" in column B
For RowToTest = Cells(Rows.Count, 1).End(xlUp).Row to startRow To Step -1
With Cells(RowToTest, 2)
If .Value = "A" Or .Value = "C" _
Then _
Rows(RowToTest).EntireRow.Delete
End With
Next RowToTest
'If the left 3 characters of the cell above it are the same,_
'then increment the renumbering scheme
For RowToTest = startRow To Cells(Rows.Count, 1).End(xlUp).Row
If Left(Cells(RowToTest, 1).Value, InStr(1, Cells(RowToTest, 1), "\")) = Left(Cells(RowToTest, 1).Offset(-1, 0).Value, InStr(1, Cells(RowToTest, 1), "\")) Then
i = i + 1
Cells(RowToTest, 1).Value = Left(Cells(RowToTest, 1).Value, InStr(1, Cells(RowToTest, 1), ".")) & i
Else
i = 0
Cells(RowToTest, 1).Value = Left(Cells(RowToTest, 1).Value, InStr(1, Cells(RowToTest, 1), ".")) & i
End If
Next RowToTest
End Sub
EDIT: I've updated it to compare all of the string before the backslash and compare using that.
EDIT++: It has been brought to my attention that when deleting rows it is better to work from the bottom up (step -1) to ensure every row is accounted for. I've re-implemented the original steps in the first code.

Answer 2

Admittedly, this isn't probably the most efficient, but it should work.
Sub DeleteRowBasedOnCriteriga()
Dim RowToTest As Long, i As Long
Application.ScreenUpdating = False
For RowToTest = Cells(Rows.Count, 2).End(xlUp).Row To 2 Step -1
With Cells(RowToTest, 2)
If .Value = "A" Or .Value = "C" Then Rows(RowToTest).EntireRow.Delete
End With
Next RowToTest
Dim totalRows As Long
totalRows = Cells(Rows.Count, 1).End(xlUp).Row
Dim curCelTxt As String, aboveCelTxt As String
For i = totalRows To i Step -1
If i = 1 Then Exit For
curCelTxt = Left(Cells(i, 1), WorksheetFunction.Search("\", Cells(i, 1)))
aboveCelTxt = Left(Cells(i - 1, 1), WorksheetFunction.Search("\", Cells(i - 1, 1)))
If curCelTxt = aboveCelTxt Then
Cells(i, 1).Value = ""
Else
Cells(i, 1).Value = WorksheetFunction.Substitute(Cells(i, 1), Right(Cells(i, 1), Len(Cells(i, 1)) - WorksheetFunction.Search(".", Cells(i, 1))), "0")
End If
Next i
Dim rng As Range, cel As Range
Dim tempLastRow As Long
Set rng = Range("A1:A" & Cells(Rows.Count, 2).End(xlUp).Row)
For Each cel In rng
If cel.Offset(1, 0).Value = "" Then
tempLastRow = cel.End(xlDown).Offset(-1, 0).Row
If tempLastRow = Rows.Count - 1 Then
tempLastRow = Cells(Rows.Count, 2).End(xlUp).Row
cel.AutoFill Destination:=Range(cel, Cells(tempLastRow, 1))
Exit For
Else
cel.AutoFill Destination:=Range(cel, Cells(tempLastRow, 1))
End If
End If
Next cel
Application.ScreenUpdating = True
End Sub
Mainly, I discovered that you can use AutoFill to fix the last number in the string. Meaning if you AutoFill this text, CAT\Definitions.0 down, you get the number updating as you drag/fill.