Replacing wildcard characters in an Excel Sheet 3

[jabrett]

I have an excel spreadsheet with numerous rows of product information. I am trying to standardise the format of the descriptions. Some of these contain wildcards within the description, others have different methods of displaying the sizes
ie
* 5" GC1 SHEET ALUMINIUM FLUE TERMINAL
needs to be displayed as
5in GC1 SHEET ALUMINIUM FLUE TERMINAL

Celcon Type "O" * FLUE TERMINAL
needs to be displayed as
Celcon Type O FLUE TERMINAL


So, my headache is....

1) How do I replace all "*"'s with ""

2) How do I replace " chr's when they are after a numeric value (Other descriptions are like: Type "O" Ring and in this case I just want to get rid of the quotes completely.

I will receive product files every week with the same descriptions (Out of my control!) So i need something that can run as VBA or a Macro.

Any help would be appreciated.

 

[Loomah]

Hi jabrett
to get you started try the following

'remove *
Cells.Replace _
What:="~*", Replacement:="", _
SearchOrder:=xlByColumns, MatchCase:=True
'remove "
Cells.Replace _
What:=Chr(34), Replacement:="", _
SearchOrder:=xlByColumns, MatchCase:=True

Dunno how or why the tilda (~) infront of the asterix works but it does! And I've only just found out about it.

The second bit will replace all quotes (&quot as I haven't worked out how to replace the ones following a number...

;-) If a man says something and there are no women there to hear him, is he still wrong?

 

[rmikesmith]

jabrett,

You can use the following procedure and function to do what you want. The procedure ConvertDescription is set up to operate on the currently selected range. This could be modified to operate on the same column while computing the number of rows, if that would be easier. The routines are fairly fast, taking just over 9.5 seconds to convert your example description 20,000 times. Some speed improvement could be gained by folding the ParseStr function code into the main procedure, eliminating the overhead of a function call for each row operated on.

Sub ConvertDescription()
Dim Rng As Range
Dim OneCell As Range

  Set Rng = ActiveWindow.Selection
  For Each OneCell In Rng
    Rng.Value = ParseStr2(Rng.Text)
  Next OneCell

End Sub


Function ParseStr(ByVal Str As String) As String
Dim tmpStr As String
Dim OneChar As String * 1
Dim Length As Long
Dim i As Long

  tmpStr = ""
  Length = Len(Str)
  For i = 1 To Length
    OneChar = Mid(Str, i, 1)
    If OneChar <> &quot;*&quot; And OneChar <> &quot;&quot;&quot;&quot; Then
      tmpStr = tmpStr & OneChar
    End If
  Next i
  ParseStr = tmpStr

End Function

Hope This Helps,
M. Smith

 

[rmikesmith]

Loomah,

Hats off to you! Your solution is much quicker (~6x by my measurement) and uses less code.

Regards,
Mike

 

[Loomah]

Thanks Mike
Unfortunately I can't do the last bit and was thinking along the lines of combining yours & mine but haven't time now - home time!!

Oh and the tilda bit, I'm reliably informed, makes excel view the next char as a run of the mill plain char.

;-) If a man says something and there are no women there to hear him, is he still wrong?

 

[rmikesmith]

Loomah,

The tilda trick alone is worth the price of admission! BTW, my tilda should be interpreted as "approximately".

Jabrett,

Loomah's last reply made me realize I may not have interpreted point 2) correctly. Do you want to replace a quotation symbol after a numeric value with some other symbol (in for inch, perhaps)? My routine, as well as Loomah's, simply removes all quotation marks. Please post back.

Regards,
Mike

 

[jabrett]

Loomah,
The Tilda sorts out the * - Thanks !

Mike and Loomah,

The issue with ' and " is for descriptions of products with measurements. A global replace would work fine except that other descriptions have things like.....
Type "O" Connector
Nut's and Bolts' (Not my spelling!)
I end up with Type inOin Connector etc.

2 Inches can be supplied as 2 " or 2" (Just to complicate even further) so I need to somehow check back to the previous valid character before the " (Ignoring any spaces) and check if it is numeric before replacing. If not numeric, I need to just remove the "
I need to do the same for '

Thanks for your help so far

Regards,
John

 

[rmikesmith]

John,

Thanks for the clarification. I am working on this (back to a VBA solution) but it may not be pretty.

Regards,
Mike

 

[rmikesmith]

John,

Here is the modified ParseStr function that will do what you requested; specifically, it will remove quote marks around alpha characters while replacing those that come after numeric characters with in (for inch). It is approximately 1 second slower per 20,000 rows compared to the first version. I could not see a way to make the built-in Excel replace function work in this instance. Let us know how this works for you and whether you need anything else. If I have time, I may try to optimize this code.

Function ParseStr(ByVal Inp As String) As String
Dim tmpStr As String
Dim Length As Long
Dim i As Long, j As Long
Dim OneChar As String * 1

  tmpStr = ""
  Length = Len(Inp)
  
  For i = 1 To Length
    OneChar = Mid$(Inp, i, 1)
    If OneChar = "*" Then
    ElseIf OneChar = """" Then
      If i + 1 <= Length Then
        If Mid$(Inp, i + 1, 1) = &quot; &quot; Then
          j = i - 1
          Do While (j >= 1) And Mid$(Inp, j, 1) = &quot; &quot;
            j = j - 1
          Loop
          If Mid$(Inp, j, 1) Like &quot;[0-9]&quot; Then
            tmpStr = Left$(tmpStr, Len(tmpStr) - (i - j - 1))
            tmpStr = tmpStr & &quot;in&quot;
          End If
        End If
      Else
        j = i - 1
        Do While (j >= 1) And Mid$(Inp, j, 1) = &quot; &quot;
          j = j - 1
        Loop
        If Mid$(Inp, j, 1) Like &quot;[0-9]&quot; Then
          tmpStr = Left$(tmpStr, Len(tmpStr) - (i - j - 1))
          tmpStr = tmpStr & &quot;in&quot;
        End If
      End If
    Else
      tmpStr = tmpStr + OneChar
    End If
  Next i
  ParseStr = Trim(tmpStr)
  
End Function

BTW, I changed the function parameter from "Str" to "Inp" because Str is a built-in function name (bad programming).

Regards,
Mike

 

[Loomah]

Well I did suggest a combination of Mike's & my solutions!

So (this not only isn't pretty, it's just ugly) here it is, warts and all. Gets rid of 5" & 5 " and incorporates my first post to sweep up!

Sub FindQuote()

Dim rngSelect 'As Range
Dim iStrLen As Integer
Dim sChar As String
Dim i As Long, j As Long, k As Long
Dim sText As String
Dim tempString As String
Dim escAddr 'As Range
   
' eliminate #" & # " by changing to '# in' & '# in' respectively
With ActiveSheet.UsedRange
    ' initial search for "
    Set rngSelect = .Find(What:=Chr(34), LookIn:=xlFormulas, LookAt:=xlPart)
    
    Do
        ' set the text and length of text
        sText = rngSelect.Text
        iStrLen = Len(sText)
        tempString = ""
            
            ' loop thru string
            For i = 1 To iStrLen
            sChar = Mid(sText, i, 1)
                ' check each char in string
                If sChar = Chr(34) And i > 1 Then
                    j = i - 1
                        ' define a moment to escape the loop!!
                        If UCase(Mid(sText, j, 1)) Like "[A-Z]" Then escAddr = rngSelect.Address
                        ' test the string for numbers or numbers & blanks
                        If Mid(sText, j, 1) Like "[0-9]" Then sChar = " in"
                            
                        If Mid(sText, j, 1) = " " Then
                            k = i - 2
                                If Mid(sText, k, 1) Like "[0-9]" Then sChar = "in"
                        End If
                End If
                tempString = tempString & sChar
            Next i
        ' replace the cell contents
        rngSelect.Value = tempString
        
        ' find next
        Set rngSelect = .FindNext(rngSelect)
    Loop While Not rngSelect.Address = escAddr
    
    'get rid of the rest of them
    ' you might recognise these!!
    Cells.Replace _
        What:=Chr(34), Replacement:="", _
        SearchOrder:=xlByColumns, MatchCase:=True
    'remove *
    Cells.Replace _
        What:="~*", Replacement:="", _
        SearchOrder:=xlByColumns, MatchCase:=True

End With
End Sub

And I still can't get a soddin' proper job!
Enjoy!!!

;-) If a man says something and there are no women there to hear him, is he still wrong?

 

[Loomah]

IGNORE THE ABOVE MAINLY

IT DOESN'T ESCAPE THE DOO...LOOP

If a man says something and there are no women there to hear him, is he still wrong?