Identify cells that end in 5 numbers

[shivus]

Hi - I have a column which has names of businesses but some of them have the zip code attached to them. For example most cells are just
ABC Company
123 Company
Def Company

But some are
ABC Company90210
123 Company10011
Def Company20007

In all the cells that have zip codes, they are always 5 digits (o 90210 and not 90210-1107) and they always start right after the last letter of the Business Name (there is no space)

Is there a way I can identify just the cells that have the zip code attached to the business name and remove the zip code digits? I do not need to save them to a different column. I just need to clean the Business Name column so those numbers dont appear next to the business name in certain cells.

Thanks!!!

 

[theBardd]

Public Sub RemoveTrailingNumbers()
Dim lastrow As Long
Dim i As Long


    Application.ScreenUpdating = False
    
    With ActiveSheet
    
        lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
        For i = 1 To lastrow
        
            If IsNumeric(Right$(.Cells(i, "A").Value, 5)) Then
            
                .Cells(i, "A").Value = Left$(.Cells(i, "A").Value, Len(.Cells(i, "A").Value) - 5)
            End If
        Next i
    End With


    Application.ScreenUpdating = True
End Sub

 

[KeepTrying]

Hi,

Please see my code below. It runs for the first column in the usedrange:

Sub RemoveFiveDigits()
Dim Cella
Dim Rng As Range
Application.ScreenUpdating = False
Set Rng = ThisWorkbook.Sheets("Sheet1").UsedRange.Columns(1) '1 is for first column in usedrange
For Each Cella In Rng.Cells
    If IsNumeric(Right(Cella.Value, 5)) Then Cella.Value = Left(Cella.Value, Len(Cella) - 5)
Next Cella
Application.ScreenUpdating = True
End Sub

Regards,

 

[Rick Rothstein]

Here is one more macro for you to consider...

Sub RemoveZipCodes()
  Dim Addr As String
  Addr = "A1:A" & Cells(Rows.Count, "A").End(xlUp).Row
  Range(Addr) = Evaluate(Replace("IF(LEN(@),IF(ISNUMBER(0+RIGHT(@,5)),LEFT(@,LEN(@)-5),@),"""")", "@", Addr))
End Sub