Excel Infinite loop issue

Question

The purpose of this program is to remove letters from cells. For some reason when it the replace function line executes it gets stuck in an infinite loop. If the cell contains 456po83 once the variables are incremented until they both equal p it the letter in the cell should be replaced with nothing and o is now the 4th character in the string and the variables should keep incrementing right? What am I missing here?

Option Explicit

Sub DeleteB()

Dim stringLength As Integer
Static str As String
Dim A As Integer
Dim num As Integer
Dim indvChar As String
Dim B As Integer
Dim charArray(0 To 25) As String

charArray(0) = "a"
charArray(1) = "b"
charArray(2) = "c"
charArray(3) = "d"
charArray(4) = "e"
charArray(5) = "f"
charArray(6) = "g"
charArray(7) = "h"
charArray(8) = "i"
charArray(9) = "j"
charArray(10) = "k"
charArray(11) = "l"
charArray(12) = "m"
charArray(13) = "n"
charArray(14) = "o"
charArray(15) = "p"
charArray(16) = "q"
charArray(17) = "r"
charArray(18) = "s"
charArray(19) = "t"
charArray(20) = "u"
charArray(21) = "v"
charArray(22) = "w"
charArray(23) = "x"
charArray(24) = "y"
charArray(25) = "z"

Do Until IsEmpty(Selection)

    A = 1
    num = Len(Selection)
    str = Selection.Value
     Do Until A = num + 1
     indvChar = Mid(str, A, 1)

        B = 0
        Do Until B = 26

            If indvChar = charArray(B) Then
            Selection.Value = Replace(str, indvChar, "", 1)

            Else: B = B + 1
            End If


        Loop

    A = A + 1
    Loop

ActiveCell.Offset(1, 0).Select
Loop

End Sub

Answer 1

If you want to find the numbers it is easier to find what you want instead of what you do not want.

Sub DeleteB()

Dim rng As Range
Dim str As String
Dim i As Integer

Set rng = Selection

Do
    For i = 1 To Len(rng.Value)
        'If your local settings uses ',' as the deliniation to decimal then change the '.' to ','
        If IsNumeric(Mid(rng.Value, i, 1)) Or Mid(rng.Value, i, 1) = "." Then
            str = str & Mid(rng.Value, i, 1)
        End If
    Next i
    rng.Value = CDbl(str)
    Set rng = rng.Offset(1)
Loop Until rng = ""

End Sub

If you only want to replace the values in the array you only need one loop.

Sub DeleteB()


Dim B As Integer
Dim charArray
Dim rng As Range

Set rng = Range(Selection, Selection.End(xlDown))

charArray = Array("a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m", "n", "o", "p", "q", "r", "s", "t", "u", "v", "w", "x", "y", "z")


For B = LBound(charArray) To UBound(charArray)
        rng.Replace What:=charArray(B), replacement:="", Lookat:=xlPart, MatchCase:=False
Next B


End Sub

This looks at the whole range at once. The method used to fill the array will allow you to add other items desired to remove without anything but adding it to the array() line. My guess is you are going to want to add spaces and other non numeric items.

Answer 2

This loop is the problem:

    Do Until B = 26

        If indvChar = charArray(B) Then
        Selection.Value = Replace(str, indvChar, "", 1)

        Else: B = B + 1
        End If


    Loop

If the character is found it replaces it with nothing, but then the doesn't increment the loop counter. Put the B = B + 1 outside of the If block.