VBA question: editing alpha characters out of numeric values

[J.B. Bobbitt]

Hi all;

I've got a LOT of numerical data in Excel workbooks to process and work
with.

The individual sheets contain 12-15 columns and 500-2000 rows or mostly
numerical data. However, many of the individual cell values have
alpha-characters as footnotes, e.g.: cell B12 might have the value "5.0a".
In addition, a lot of the cells have a "less than" comparitor, e.g.:
"<5.0", and "<5.0a"

I can deal with the "<" easily enough by using a global find-replace,
replacing it as a negative sign, and treating the vlaue as a negative
number. I can also do a global find-replace for each letter in the
alphabet, and replce the character with nothing.

But is there an easier way to get rid of the alpha-character footnotes than
using 26 find-replace statements? Is there a function or command or
statement that can get rid of all alpha-characters without having to call
out each one?

Thanks a heap,
-jbb

 

[Robin Hammond]

JB,

Here's a 5 minute try at it. I haven't got your data, so be careful and
backup your sheet FIRST please.

Sub ReplaceWithNumericValues()
Dim rngCell As Range

'backup your sheet FIRST
'select the range first
For Each rngCell In Selection

rngCell.Value = FindNumericSubString(rngCell)

Next rngCell

End Sub

Function FindNumericSubString(rngCell As Range) As Variant
Dim nCounter As Integer
Dim nChr As Integer
Dim strValue As String
Dim strOutput As String
Dim nLength As Integer

If IsEmpty(rngCell.Value) Then Exit Function

If IsNumeric(rngCell.Value) Then

FindNumericSubString = rngCell.Value
Exit Function

End If

nCounter = 1
strValue = rngCell.Value
nLength = Len(strValue)

nChr = Asc(Mid(strValue, nCounter, 1))

Do Until (nChr >= 48 And nChr <= 57) Or nChr = 45 Or nChr = 46

nCounter = nCounter + 1
nChr = Asc(Mid(strValue, nCounter, 1))
If nCounter > nLength Then Exit Function

Loop

strOutput = Chr(nChr)
nCounter = nCounter + 1
nChr = Asc(Mid(strValue, nCounter, 1))

Do While ((nChr >= 48 And nChr <= 57) Or nChr = 46)

strOutput = strOutput & Mid(strValue, nCounter, 1)
nCounter = nCounter + 1
If nCounter > nLength Then Exit Do
nChr = Asc(Mid(strValue, nCounter, 1))

Loop

On Error Resume Next
FindNumericSubString = CDbl(strOutput)
On Error GoTo 0

End Function

Robin Hammond
www.enhanceddatasystems.com

 

[J.B. Bobbitt]

Wow. Thanks for the effort, Robin.

-jbb

JB,

Here's a 5 minute try at it. I haven't got your data, so be careful and
backup your sheet FIRST please.

Sub ReplaceWithNumericValues()
Dim rngCell As Range

'backup your sheet FIRST
'select the range first
For Each rngCell In Selection

rngCell.Value = FindNumericSubString(rngCell)

Next rngCell

End Sub

Function FindNumericSubString(rngCell As Range) As Variant
Dim nCounter As Integer
Dim nChr As Integer
Dim strValue As String
Dim strOutput As String
Dim nLength As Integer

If IsEmpty(rngCell.Value) Then Exit Function

If IsNumeric(rngCell.Value) Then

FindNumericSubString = rngCell.Value
Exit Function

End If

nCounter = 1
strValue = rngCell.Value
nLength = Len(strValue)

nChr = Asc(Mid(strValue, nCounter, 1))

Do Until (nChr >= 48 And nChr <= 57) Or nChr = 45 Or nChr = 46

nCounter = nCounter + 1
nChr = Asc(Mid(strValue, nCounter, 1))
If nCounter > nLength Then Exit Function

Loop

strOutput = Chr(nChr)
nCounter = nCounter + 1
nChr = Asc(Mid(strValue, nCounter, 1))

Do While ((nChr >= 48 And nChr <= 57) Or nChr = 46)

strOutput = strOutput & Mid(strValue, nCounter, 1)
nCounter = nCounter + 1
If nCounter > nLength Then Exit Do
nChr = Asc(Mid(strValue, nCounter, 1))

Loop

On Error Resume Next
FindNumericSubString = CDbl(strOutput)
On Error GoTo 0

End Function

Robin Hammond
www.enhanceddatasystems.com