Hi there,

I need to write a small loop that removes all non-numeric characters
from a string variable (unformattedString).  I can do this in all the
languages I know but VBA makes me want to scream lol

We will use the following variables:

- Dim unformattedString As String
- Dim formattedString As String



Also, if anyone knows of any good tutorials and documentation for VBA
newbies, I'd really appreciate it.  I'm not a fan of the MSDN for
learning purposes.

Thanks~

<victoria.r***@gmail.com> wrote in message
what have you tried?  The Mid$ statement and functions will probably be
useful; also maybe the Like operator and the UCase$/LCase$ functions.

She could look at IsNumeric as well.

Dave O.

Show quoteHide quote

d'oh!  somehow I read "remove non-numeric" as "remove alphabetic"

This is untested air code, written off the top of my head, but here goes.
There are more efficient ways of writing this (like not repeating the
Mid$(), and I think Like is a slow method of doing it, but this'll get you
the logic, and you can go from there).

    Dim i As Long
    Dim unformattedString As String
    Dim formattedString As String

    formattedString = "" 'technically unnecessary, but good form
    For i = 1 To Len(unformattedString)
        If Mid$(unformattedString, i, 1) Like "[0-9]" Then
            formattedString = formattedString & Mid$(unformattedString, i,
1)
        End If
    Next



Rob

<victoria.r***@gmail.com> wrote in message
Show quoteHide quote

Show quote Hide quote Another possibility is this...

Dim X As Long
Dim unformattedString As String
Dim formattedString As String
formattedString = unformattedString
For X = 0 to 9
  formattedString = Replace(formattedString, CStr(X), "")
Next

or, for those who prefer to see it in one-liner format...

Dim unformattedString As String
Dim formattedString As String
formattedString = Replace(Replace(Replace(Replace(Replace( _
                  Replace(Replace(Replace(Replace(Replace( _
                  unformattedString, "0", ""), "1", ""), _
                  "2", ""), "3", ""), "4", ""), "5", ""), _
                  "6", ""), "7", ""), "8", ""), "9", "")

<g>

Rick

Uhh...I think that's working backwards.  The OP wanted to replace the
NON-numeric characters.

You do have a point about the various non-concatenation methods of doing
this, but I figured the OP would want simple if she's still new to VB, not
the fastest possible method, which involved a fair bit more coding.  (Though
the Mid()/buffer method sure comes in handy when you're constructing large
strings, like an entire RTF file.)



Rob

Show quoteHide quote

Whoops! You are right... I misread the post.

Rick

We're just all batting 1000 today, aren't we?  Bob misread it as alphabetic,
you misread it as numeric, and I missed the glaringly obvious IsNumeric()
function.  Either it's Friday afternoon or Monday morning. ;-)



Rob

Show quoteHide quote

Show quote Hide quote You might consider changing your code to avoid all of those concatenations.
Something like this maybe....

    Dim i As Long
    Dim unformattedString As String
    Dim formattedString As String

    formattedString = unformattedString
    For i = 1 To Len(unformattedString)
        If Mid$(formattedString, i, 1) Like "[0-9]" Then
            Mid$(formattedString, i, 1) = " "
        End If
    Next
    formattedString = Replace(formattedString, " ", "")

Rick

Rick Rothstein (MVP - VB) <rickNOSPAMnews@NOSPAMcomcast.net> wrote:
Show quoteHide quoteYou don't suppose Replace is concatenation-based? <g>

"Back in the day...", seems we used to create an equivalent sized buffer, hold a
pointer to the first empty slot in it, and sling 'em over as needed incrementing the
pointer as we went.

I don't think so, Carl. It would be very much slower than it is if it were
concatenation based. It obviously isn't as optimised as it could be, but it
is definitely nowhere near as slow as it would be if it performed the
replace by repeated concatenation of a string that is repeatedly increasing
in size.

Yep. That's what I used to do as well. In fact here (below) is some code
which testbeds some VB5 code I wrote many years ago when I was first getting
to grips with Visual Basic (when VB5 was the latest version and which did
not have a Replace function). That was quite a few years ago of course, and
I've moved on a bit since then. These days I would probably transfer the
string data to a byte array (without actually copying or moving the data)
using a SafeArray structure. However, machines are getting so fast these
days that it usually isn't worth going to the trouble, and I would simply
use the VB6 replace function ;-)

Anyway, here's the code. paste it into a VB Form containing two Command
Buttons and compile it to a Native Code exe. Note the "trick" I used to
avoid the speed limitations of the VB string functions when used in Text
rather than Binary mode. I was quite proud of that at the time, although it
probably looks a bit "b=naff" now of course ;-)

Mike

Option Explicit
Private Declare Function QueryPerformanceFrequency _
  Lib "kernel32" (lpFrequency As Currency) As Long
Private Declare Function QueryPerformanceCounter _
  Lib "kernel32" (lpPerformanceCount As Currency) As Long
Private s1 As String

Private Sub Form_Load()
Dim n As Long
s1 = "Rum and Coke is a wonderful drink but for " & _
    "best results it really needs to be Lambs Navy Rum " & _
    "and Coke and it needs to be real Coke. "
For n = 1 To 10
s1 = s1 + s1
Next n
Caption = "Test String Length =" & Len(s1)
End Sub

Private Function ReplaceAll(ByRef txtWork As String, ByVal _
txtFind As String, ByVal txtReplace As String, ByVal compare _
As Long, ByRef replacecount As Long) As String
Dim txtNew As String, Ltxtnew As Long
Dim Start As Long, Counter As Long, n As Long
Dim Lfind As Long, Lreplace As Long
Dim OldPointer As Long, NewPointer As Long
Dim txtTemp As String
replacecount = 0
Lfind = Len(txtFind)
If Lfind < 1 Then
  ReplaceAll = txtWork
  Exit Function
End If
Lreplace = Len(txtReplace)
' the following code avoids the need to use
' vbTextCompare (which is very slow)
If compare = vbTextCompare Then
txtTemp = UCase(txtWork)
txtFind = UCase(txtFind)
Else
txtTemp = txtWork
End If
Start = 1 - Lfind
Do
Start = InStr(Start + Lfind, txtTemp, txtFind, 0)
If Start <> 0 Then Counter = Counter + 1 Else Exit Do
Loop
If Counter < 1 Then
ReplaceAll = txtWork
Exit Function
Else
Ltxtnew = Len(txtWork) + Counter * (Lreplace - Lfind)
txtNew = Space$(Ltxtnew)
Start = 1 - Lfind
OldPointer = 1
NewPointer = 1
On Error Resume Next
' the Resume Next is the easiest way to prevent
' errors being generated when the search word is
' exactly at the end of the text and the replace
' string is empty as it avoids other forms of
' check inside the loop slowing the code down
For n = 1 To Counter
  Start = InStr(Start + Lfind, txtTemp, txtFind, 0)
  Mid$(txtNew, NewPointer, Start - OldPointer) = _
  Mid$(txtWork, OldPointer, Start - OldPointer)
  NewPointer = NewPointer + Start - OldPointer + Lreplace
  Mid$(txtNew, NewPointer - Lreplace, Lreplace) = txtReplace
  OldPointer = Start + Lfind
Next n
On Error GoTo 0
If OldPointer <= Len(txtWork) Then
  Mid$(txtNew, NewPointer) = Mid$(txtWork, OldPointer)
End If
End If
ReplaceAll = txtNew
replacecount = Counter
End Function

Private Sub Command1_Click()
Dim frequency As Currency, offset As Currency
Dim startTime As Currency, endTime As Currency
Dim result1 As Double, result2 As Double
Dim s2 As String
If QueryPerformanceFrequency(frequency) = 0 Then
  Exit Sub ' system doesn't support performance counter
End If
QueryPerformanceCounter startTime
QueryPerformanceCounter endTime
offset = endTime - startTime
QueryPerformanceCounter startTime
' code to time goes here
s2 = Replace(s1, "Lambs Navy", _
  "Captain Morgan", , , vbTextCompare)
'
QueryPerformanceCounter endTime
result1 = CDbl(endTime - startTime - offset) / frequency
result1 = CLng(result1 * 1000000)
Print "Standard VB6 Replace Function . . ."
Print result1 & " microseconds", Len(s1), Len(s2)
Print
End Sub

Private Sub Command2_Click()
Dim frequency As Currency, offset As Currency
Dim startTime As Currency, endTime As Currency
Dim result1 As Double, result2 As Double
Dim s2 As String, rcount As Long
If QueryPerformanceFrequency(frequency) = 0 Then
  Exit Sub ' system doesn't support performance counter
End If
QueryPerformanceCounter startTime
QueryPerformanceCounter endTime
offset = endTime - startTime
QueryPerformanceCounter startTime
' code to time goes here
' in this ReplaceAll example the number of replacements
' made is returned in the rcount variable
s2 = ReplaceAll(s1, "Lambs Navy", "Captain Morgan", _
  vbTextCompare, rcount)
'
QueryPerformanceCounter endTime
result1 = CDbl(endTime - startTime - offset) / frequency
result1 = CLng(result1 * 1000000)
Print "Mike's coded Replace function . . ."
Print result1 & " microseconds", Len(s1), Len(s2)
Print
End Sub

Mike Williams <m***@whiskyandCoke.com> wrote:
I dunno 'bout that.  I mean, I tend to agree that it's not *as bad* as it could
possibly be, but I don't think it's anywhere near as good as could be, either.

The more things change..., huh? <g>

Show quoteHide quoteKinda scary how familiar that looks, just at a glance.  Here's a dozen other stabs
at the same thing, some bettering VB's performance by more than an order of
magnitude.

   http://www.xbeat.net/vbspeed/c_Replace.htm

I snarfed one of the simpler ones, years ago.  As you said, the hardware's so
fast... <g>

Later...   Karl

I don't know;  but whatever Replace does, it does it much, much faster than
the equivalent VB concatenation code.

Rick

Rick Rothstein (MVP - VB) <rickNOSPAMnews@NOSPAMcomcast.net> wrote:
I don't either, to be honest.  But it performs on a par with some of the concat code
here:

   http://www.xbeat.net/vbspeed/c_Replace.htm

Something like:

Function NumbersOnly(Source As String) As String
Dim out As String
Dim src As Long, dst As Long

  out = Space$(Len(Source))
  dst = 1
  For src = 1 To Len(Source)
    Select Case Asc(Mid$(Source, src, 1))
    Case 48 To 57
      Mid(out, dst, 1) = Mid$(Source, src, 1)
      dst = dst + 1
    End Select
  Next
  NumbersOnly = Trim$(out)
End Function

LFS

That would be the buffer method, yup. :-)  It's a little arcane for the
novice programmer (though admittedly, the OP said he wasn't a novice
*programmer*, just a VB novice), but probably just about the fastest method
there is, except maybe on REALLY short strings.

It all goes to show just how many ways you can skin a cat in VB.  (Uh oh...I
mentioned another cat...let's not get side-tracked with those GD'd cats
again <g>.)



Rob

Show quoteHide quote

Errr..."she"...sorry!  Stupid male-dominated newsgroups...I start thinking
EVERYBODY's male. <blush>

Larry Serflaten <serfla***@usinternet.com> wrote:
Show quoteHide quotePerzactly!

Show quote Hide quote Just to keep the record straight, the above code does not do what the OP
wanted. The following code does...

    Dim i As Long
    Dim unformattedString As String
    Dim formattedString As String
    formattedString = unformattedString
    For i = 1 To Len(unformattedString)
        If Mid$(formattedString, i, 1) Like "[!0-9]" Then
            Mid$(formattedString, i, 1) = " "
        End If
    Next
    formattedString = Replace(formattedString, " ", "")

The only change that was made was adding the exclamation point symbol (!)
inside the square-brackets in the If-Like statement.

Rick

Well, this isn't a VBA forum by rights, so you'll find more help in the
Office category I should think.

Meanwhile, here's some string filtering functions I use fairly regularly in
VBA. The FilterNumber() function should be what you're looking for here. It's
configured for use in Excel but with some tweaking it should do what you want.

These functions all return the result as a string value. Look carefully in
the comments to see what companion functions may be required for any given
procedure.

HTH
Regards,
Garry

code follows...

Function FilterNumber(ByVal szText As String, ByVal bTrimZeros As Boolean)
As String
' Filters out formatting characters in a number and trims any trailing
decimal zeros
' Requires the FilterString() function
' Arguments:      szText          The string being filtered
'                 bTrimZeros      True to remove trailing decimal zeros
'
' Returns:        String containing valid numeric characters only.

Const sSource As String = "FilterNumber()"

  Dim sDecSep As String, i As Long, sResult As String

  'Retreive the decimal separator symbol
  sDecSep = Application.International(xlDecimalSeparator) 'Format$(0.1, ".")

  'Filter out formatting characters
  ' -Choose one of the following
  sResult = FilterString(szText, "0123456789") 'digits only
'  sResult = FilterString(szText, sDecSep & "-0123456789") 'financials

  'If there's a decimal part, trim any trailing decimal zeros
  If bTrimZeros And InStr(szText, sDecSep) > 0 Then
    For i = Len(sResult) To 1 Step -1
      Select Case Mid$(sResult, i, 1)
        Case sDecSep
          sResult = Left$(sResult, i - 1)
          Exit For
        Case "0"
          sResult = Left$(sResult, i - 1)
        Case Else
          Exit For
      End Select
    Next
  End If
  FilterNumber = sResult

End Function

Function FilterString(ByVal szText As String, ByVal szValidChars As String)
As String
' Filters out all unwanted characters in a string.
' Arguments:      szText          The string being filtered
'                 szValidChars    The characters to keep
'
' Returns:        String containing only the valid characters.

Const sSource As String = "FilterString()"

  Dim i As Long, sResult As String

  For i = 1 To Len(szText)
    If InStr(szValidChars, Mid$(szText, i, 1)) Then sResult = sResult &
Mid$(szText, i, 1)
  Next
  FilterString = sResult

End Function

Function FilterString2(ByVal szText As String, Optional szValidChars As
String) As String
' Filters out all unwanted characters in a string.
' Arguments:      szText          The string being filtered
'                 szValidChars    [Optional] Any additional characters to keep
'
' Returns:        String containing only the valid characters.

Const sSource As String = "FilterString2()"

  Dim i As Long
  Dim sResult As String, sAlphaChrs As String, sNumbers As String

  'The basic characters to keep
  sAlphaChrs = "abcdefghijklmnopqrstuvwxyz"
  sNumbers = "0123456789"

  szValidChars = szValidChars & sAlphaChrs & UCase(sAlphaChrs) & sNumbers
  For i = 1 To Len(szText)
    If InStr(szValidChars, Mid$(szText, i, 1)) Then sResult = sResult &
Mid$(szText, i, 1)
  Next
  FilterString2 = sResult

End Function

Function FilterString3(ByVal szText As String, Optional szValidChars As
String, Optional bNumbers As Boolean = True) As String
' Filters out all unwanted characters in a string.
' Arguments:      szText          The string being filtered
'                 szValidChars    [Optional] Any additional characters to keep
'                 bNumbers        [Optional] Include numbers as valid
characters. Default = True
'
' Returns:        String containing only the valid characters.

Const sSource As String = "FilterString2()"

  Dim i As Long
  Dim sResult As String, sAlphaChrs As String, sNumbers As String

  'The basic characters to keep
  sAlphaChrs = "abcdefghijklmnopqrstuvwxyz"
  sNumbers = "0123456789"

  If bNumbers Then
    szValidChars = szValidChars & sAlphaChrs & UCase(sAlphaChrs) & sNumbers
  Else
    szValidChars = szValidChars & sAlphaChrs & UCase(sAlphaChrs)
  End If

  For i = 1 To Len(szText)
    If InStr(szValidChars, Mid$(szText, i, 1)) Then sResult = sResult &
Mid$(szText, i, 1)
  Next
  FilterString3 = sResult

End Function

Error 7: "Out of memory" opening a file...but I have plenty!
VB6 - test for screen resolution
!!
Bytes per Sector
Read .htm as Dom
VB Icons
Scanners - MSComm
vb6 com+ out of memory issue
Assign NULL to date field
Getting 'Project or Library not found'