Find/Replace to remove alpha characters

[wjvghost]

Hello,

I am not sure if the title appropriately describes that for which I am seeking.

I would like to know if it is possible to do a lookup on a 7 digit number which is part of an alphanumeric string and remove all other parts of the cell that don't pertain.

For example, "something 3882712" would filter down to 3882712.

I currently have a Private Sub on Sheet1 to do a primitive method of what I want. However, not everything is always structured in the way which this module works:

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim CCell As Range

    Set CCells = Range("C2:C501")
    
    If Not Application.Intersect(KeyCells, Range(Target.Address)) _
           Is Nothing Then
    CCells.Replace What:="* 3", Replacement:="3", LookAt:=xlPart
    CCells.Replace What:="* 2", Replacement:="2", LookAt:=xlPart
    End If
End Sub

Sometimes the number string is before or after alpha characters, and I want a method that will grab this number regardless of where it is located in the cell.

Is it easier to "forbid" alpha characters from existing in the module with a Find/replace method? I have not tried this method yet, but I did not want to create a module which would weigh down on Excel if that would be the case. This worksheet is in use by a group of other employees as well. I am trying to keep it as lightweight as possible.

Any thoughts or suggestions on the matter?

 

[Joe4]

Is it easier to "forbid" alpha characters from existing in the module with a Find/replace method? I have not tried this method yet, but I did not want to create a module which would weigh down on Excel if that would be the case. This worksheet is in use by a group of other employees as well. I am trying to keep it as lightweight as possible.

I believe so. And you may even be able to avoid the use of VBA altogether here.
If the first digit in your seven digit number cannot be a zero, then you could use Data Validation, requiring the entry to be between 1000000 and 9999999.

 

[Joe4]

If you may have entries starting with zeroes, try this Worksheet_Change procedure instead:

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim CCells As Range
    Dim cell As Range
    Dim mess As String

    Set CCells = Intersect(Range("C2:C501"), Target)
    
    If Not CCells Is Nothing Then
        Application.EnableEvents = False
        For Each cell In CCells
            If Len(cell) <> 7 Or Not IsNumeric(cell) Then
                cell.ClearContents
                mess = mess & cell.Address(0, 0) & vbCrLf
            End If
        Next cell
        Application.EnableEvents = True
    End If
    
    If Len(mess) > 0 Then
        MsgBox "You have entered invalid entries in cells:" & vbCrLf & mess, _
            vbOKOnly, "ENTRY ERROR!"
    End If
            
End Sub