Solved: VBA Code to Delete Records on Condition

[Slicemahn]

Hello Everyone!

I have been struggling with this code for the past few days. I would like to cycle through a list of records and choose only the names with the prefix "m" or "r". From there the records are written to a database table for storage. I have handled this task modularly, so the code to write the records from Excel to Access is fine. My problem is getting the right records when my code executes. Here is my code:
[VBA]Private Sub TrimtheTree()
Dim EndRow As Integer
Dim RowLoop As Integer
Dim StringChecker As Integer
Dim FindDash As Integer
Dim mpComma As Long
Dim mpSign As Long
Dim mpId As String

With Worksheets("Data")
EndRow = .Cells(.Rows.Count, 1).End(xlUp).Row
For RowLoop = EndRow To 10 Step -1

If Left(Cells(RowLoop, 1).Value, 1) = "m" Or Left(Cells(RowLoop, 1).Value, 1) = "r" Then
With Cells(RowLoop, 1)
On Error Resume Next
mpSign = InStr(.Value, ".")
End With
ElseIf Left(Cells(RowLoop, 1).Value, 1) <> "m" Or Left(Cells(RowLoop, 1).Value, 1) <> "r" Then
Rows(RowLoop).Delete
End If


If Left(Cells(RowLoop, 1).Value, 1) = "m" Or Left(Cells(RowLoop, 1).Value, 1) = "r" Then
mpId = Mid(Cells(RowLoop, 1).Value, (mpSign + 1), Len(Cells(RowLoop, 1).Value) - (mpSign))
Cells(RowLoop, 1).Value = UCase(mpId)
mpSign = 0
ElseIf Left(Cells(RowLoop, 1).Value, 1) <> "m" Or Left(Cells(RowLoop, 1).Value, 1) <> "r" Then
Rows(RowLoop).Delete
End If

Next RowLoop
End With
End Sub[/VBA]

I have also attached the data list from which I am using.

All suggestions and aid on this is appreciated.

Many thanks in advance.

[MikeO]

Here, try this.
[vba]Private Sub TrimtheTree()
Dim mpSign As Long
Dim mpId As String
Dim CheckCell As Range

Set CheckCell = Worksheets("Data").Range("A65536").End(xlUp)
Do While CheckCell.Row > 6
If Left(CheckCell, 1) = "m" Or Left(CheckCell, 1) = "r" Then
mpSign = InStr(CheckCell, ".")
mpId = Mid(CheckCell, (mpSign + 1), Len(CheckCell) - (mpSign))
CheckCell = UCase(mpId)
mpSign = 0
Set CheckCell = CheckCell.Offset(-1)
Else
Set CheckCell = CheckCell.Offset(-1)
CheckCell.Offset(1).EntireRow.Delete
End If
Loop
End Sub
[/vba]

I think you were trying to make it more complicated than it needed to be.

[Bob Phillips]

I have only looked at the code, but this seems better

[vba]

Private Sub TrimtheTree()
Dim EndRow As Integer
Dim RowLoop As Integer
Dim mpSign As Long
Dim mpId As String

With Worksheets("Data")

EndRow = .Cells(.Rows.Count, 1).End(xlUp).Row
For RowLoop = EndRow To 10 Step -1

If Left(.Cells(RowLoop, 1).Value, 1) = "m" Or _
Left(.Cells(RowLoop, 1).Value, 1) = "r" Then

mpSign = InStr(Cells(RowLoop, 1).Value, ".")
mpId = Mid(.Cells(RowLoop, 1).Value, (mpSign + 1), Len(.Cells(RowLoop, 1).Value) - (mpSign))
.Cells(RowLoop, 1).Value = UCase(mpId)
Else

.Rows(RowLoop).Delete
End If
Next RowLoop
End With
End Sub
[/vba]