Find and replace vba wildcards

[hatstand]

Hi,

I’m trying to write a piece of code to find all full stops with a space or spaces in front of it. To be replaced with a full stop with no spaces. It works if I state

what = “ .”

But as there can be more than one space before the full stop. It ignores anything with more than one space. I want to include something that can be any amount of spaces i.e. a wildcard.

Am I on the right track?

Sub replace()

Dim findit As String
Dim repl As String
Dim what As String

what = "."
repl = "."

Cells.replace what:=what, Replacement:=repl, LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

End Sub

 

[pgc01]

Hi

Try replacing your statement with:

what = " *."

 

[hatstand]

Thanks for the reply.

That works, but also takes out all letters to the left of the space, back to the first word. Maybe I'm approaching this the wrong way and should be looking for something that replaces " ." OR " ." OR " ." etc

 

[GTO]

This seems to work. Maybe not the fastest....

Option Explicit
    
Sub exa()
Dim _
wks             As Worksheet, _
Cell            As Range, _
FirstAddress    As String, _
CellText        As String
    
    '// Ditch the IF and replace ActiveSheet.Name with name of worksheet                //
    If TypeName(ActiveSheet) = "Worksheet" Then
        Set wks = ThisWorkbook.Worksheets(ActiveSheet.Name)
        If wks Is Nothing Then Exit Sub
    End If
    
    Set Cell = RangeFound(wks.Cells, ".", , , , , xlNext)
    
    If Not Cell Is Nothing Then
        FirstAddress = Cell.Address
        Do
            CellText = Cell.Text
            Cell.Value = TrimString(CellText)
            Set Cell = wks.Cells.FindNext(Cell)
        Loop While Not Cell.Address = FirstAddress
    End If
End Sub
    
Function TrimString(ByVal CellString As String) As String
    
    Do While InStr(1, CellString, Chr(32) & Chr(46))
        CellString = Replace(CellString, Chr(32) & Chr(46), Chr(46))
    Loop
    
    TrimString = CellString
End Function
    
Function RangeFound(SearchRange As Range, _
                    Optional ByVal FindWhat As String = "*", _
                    Optional StartingAfter As Range, _
                    Optional LookAtTextOrFormula As XlFindLookIn = xlValues, _
                    Optional LookAtWholeOrPart As XlLookAt = xlPart, _
                    Optional SearchRowCol As XlSearchOrder = xlByRows, _
                    Optional SearchUpDn As XlSearchDirection = xlPrevious, _
                    Optional bMatchCase As Boolean = False) As Range
    
    If StartingAfter Is Nothing Then
        Set StartingAfter = SearchRange(1)
    End If
    
    Set RangeFound = SearchRange.Find(What:=FindWhat, _
                                      After:=StartingAfter, _
                                      LookIn:=LookAtTextOrFormula, _
                                      LookAt:=LookAtWholeOrPart, _
                                      SearchOrder:=SearchRowCol, _
                                      SearchDirection:=SearchUpDn, _
                                      MatchCase:=bMatchCase)
End Function

 

[pgc01]

Thanks for the reply.

That works, but also takes out all letters to the left of the space, back to the first word. Maybe I'm approaching this the wrong way and should be looking for something that replaces " ." OR " ." OR " ." etc

Sorry, you are right, " *." will match also any characters between the space and the dot, which is not what you need.

I think this will solve the problem. Please try:

Sub ReplaceSpacesDot()
Dim r As Range
Dim sWhat As String
Dim sRInit As String
 
sWhat = " ."
Set r = Cells.Find(what:=sWhat, LookAt:=xlPart)
If r Is Nothing Then Exit Sub
sRInit = r.Address
 
With CreateObject("VBScript.RegExp")
    .Pattern = " +\."
    .Global = True
    Do
        If Not r.HasFormula Then r.Value = .replace(r.Value, ".")
        Set r = Cells.FindNext
        If r Is Nothing Then Exit Do
    Loop While r.Address <> sRInit
End With
End Sub

 

[Peter_SSs]

A bit late on the scene here but two comments and one suggestion.

Comments:
1. I'd recommend to not use variable names that are special words in vba ( your 'what' variable)

It works if I state

what = “ .”

But as there can be more than one space before the full stop. It ignores anything with more than one space.

2. It won't be ignoring these cases, it will be doing a replacement thereby reducing the number of spaces before the dot by one - which leads to my suggestion below.


Suggestion:
A bit 'brute force' but simple concept ..

<font face=Courier New><SPAN style="color:#00007F">Sub</SPAN> FixSpaces()<br>    <SPAN style="color:#00007F">Dim</SPAN> i <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN><br>    <br>    <SPAN style="color:#00007F">Const</SPAN> sWhat <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN> = " ." <SPAN style="color:#007F00">'<-Single space before the dot</SPAN><br>    <SPAN style="color:#00007F">Const</SPAN> sRepl <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN> = "."<br>    <SPAN style="color:#00007F">Const</SPAN> lMaxExpectedSpaces <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN> = 10 <SPAN style="color:#007F00">'<-Change to suit</SPAN><br>    <br>    Application.ScreenUpdating = <SPAN style="color:#00007F">False</SPAN><br>    <SPAN style="color:#00007F">For</SPAN> i = 1 <SPAN style="color:#00007F">To</SPAN> lMaxExpectedSpaces<br>        ActiveSheet.UsedRange.Replace What:=sWhat, Replacement:=sRepl, _<br>            LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _<br>            SearchFormat:=False, ReplaceFormat:=False<br>    <SPAN style="color:#00007F">Next</SPAN> i<br>    Application.ScreenUpdating = <SPAN style="color:#00007F">True</SPAN><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN></FONT>

 

[hatstand]

Thanks for your reply Peter, much appreciated. and a thanks to pgc01. Both bits of code have helped me and will be going into my file for future use.

thanks.