Click here to Skip to main content
15,880,651 members
Please Sign up or sign in to vote.
3.00/5 (1 vote)
See more:
I have been searching for the answer to few days, but nothing yet.
In case any capital or small text and number are then space requirement below there. VBA macro runs only match case only [A . & a . & 1 .] should be [A. & a. & 1.] removing space

1	. 	 DOT	              No Space Before & After Single Space
2	: 	 Colon	              No Space Before & After Single Space
3	, 	 Comma	              No Space Before & After Single Space
4	( 	 Opening Parenthesis  Before Single Space & No Space After
5	) 	 Closing Parenthesis  No Space Before & After Single Space
6	/ 	 Slash	              No Space Before & After
7	- 	 Hyphen	              Before & After Single Space
8	" 	 Left double quote    Before Single Space & No Space After
9	" 	 Right double quote   No Space Before & After Single Space
10	! 	 Exclamation point    No Space Before & After
11	# 	 Number sign	      No Space Before & After
12	* 	 Asterisk	      No Space Before & After
13	; 	 Semicolon	      No Space Before & After Single Space
14	_ 	 Underscore	      No Space Before & After
15	{ 	 Opening Brace	      Before Single Space & No Space After
16	} 	 Closing Brace	      No Space Before & After Single Space
17	‘ 	 Left Single Quote    No Space Before & After
18	’ 	 Right Single Quote   No Space Before & After

In case 2 symbols Conflict then we have VBA macro.

What I have tried:

I have start coding:


VB
Sub Multi_FindReplace()

Dim sht As Worksheet
Dim fndList As Variant
Dim rplcList As Variant
Dim x As Long

fndList = Array(":.", ",.")
rplcList = Array(": .", ", .")

'but there is limits of replacing only 50


For x = LBound(fndList) To UBound(fndList)
For Each sht In ActiveWorkbook.Worksheets
sht.Cells.Replace What:=fndList(x), Replacement:=rplcList(x), _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
SearchFormat:=False, ReplaceFormat:=False
Next sht

Next x

End Sub
Posted
Updated 3-May-17 10:44am
v3
Comments
CHill60 3-May-17 4:30am    
The "What I have tried" section is for you to post the code that you have tried. We are not going to write all the code for you
pankajjadhav83 3-May-17 5:14am    
I have start coding

Sub Multi_FindReplace()

Dim sht As Worksheet
Dim fndList As Variant
Dim rplcList As Variant
Dim x As Long

fndList = Array(":.", ",.")
rplcList = Array(": .", ", .")

'but there is limits of replacing only 50


For x = LBound(fndList) To UBound(fndList)
For Each sht In ActiveWorkbook.Worksheets
sht.Cells.Replace What:=fndList(x), Replacement:=rplcList(x), _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
SearchFormat:=False, ReplaceFormat:=False
Next sht

Next x

End Sub

You need to use RegEx (Regular Expressions) because for each symbol, you need to get all surrounding spaces, then replace with what you want by using the RegEx replace function.
This RegEx
"\s*,\s*"

locate comas and spaces surrounding.
Excel Regex Tutorial (Regular Expressions) - The Analyst Cave | Excel, VBA, programming and more[^]

A few interesting links to help building and debugging RegEx.
Here is a link to RegEx documentation:
perlre - perldoc.perl.org[^]
Here is links to tools to help build RegEx and debug them:
.NET Regex Tester - Regex Storm[^]
Expresso Regular Expression Tool[^]
This one show you the RegEx as a nice graph which is really helpful to understand what is doing a RegEx:
Debuggex: Online visual regex tester. JavaScript, Python, and PCRE.[^]
 
Share this answer
 
Comments
Maciej Los 4-May-17 1:28am    
5ed!
Patrice T 4-May-17 1:32am    
Thank you
I did this as an exercise. I'm not convinced that my approach is particularly good and it could potentially take some time to process but here goes...

I set up a couple of arrays. One holds the symbol that could be affected and the other holds the rules as laid out in your question. The indexes of each element of each array must match up.
VB
Dim arrSymbols(19) As String
Dim arrCorrect(19) As String
Public Sub SetUp()
    arrSymbols(1) = ".": arrCorrect(1) = ". "
    arrSymbols(2) = ":": arrCorrect(2) = ": "
    arrSymbols(3) = ",": arrCorrect(3) = ", "
    arrSymbols(4) = "(": arrCorrect(4) = " ("
    arrSymbols(5) = ")": arrCorrect(5) = ") "
    arrSymbols(6) = "/": arrCorrect(6) = "/"
    arrSymbols(7) = "-": arrCorrect(7) = " - "
    arrSymbols(8) = "!": arrCorrect(8) = "!"
    arrSymbols(9) = "#": arrCorrect(9) = "#"
    arrSymbols(10) = "*": arrCorrect(10) = "*"
    arrSymbols(11) = ";": arrCorrect(11) = "; "
    arrSymbols(12) = "_": arrCorrect(12) = "_"
    arrSymbols(13) = "{": arrCorrect(13) = " {"
    arrSymbols(14) = "}": arrCorrect(14) = "} "
    arrSymbols(15) = "'": arrCorrect(15) = "'"
    arrSymbols(16) = Chr$(145): arrCorrect(16) = Chr$(145)  'Left single quote
    arrSymbols(17) = Chr$(146): arrCorrect(17) = Chr$(146)  'Right single quote
    arrSymbols(18) = Chr$(147): arrCorrect(18) = " " & Chr$(147)  'Left double quote
    arrSymbols(19) = Chr$(148): arrCorrect(19) = " " & Chr$(148)  'Right double quote
End Sub
I included a function to see if any of the symbols actually appear anywhere in the input string. To try and improve performance it returns immediately it finds any of the symbols...
VB
Public Function Contains(Test As String, Against() As String) As Boolean

    Dim i As Integer
    Contains = False
    
    For i = 1 To UBound(Against)
    
        If InStr(Test, Against(i)) Then
            Contains = True
            Exit For
        End If
    
    Next

End Function
The actual function that does the work first checks to see if anything needs to be done (and if not, just returns the original string input).
For each of the symbols to be considered, and only if that symbol appears in the input string, it replaces all instances of a space + symbol with just symbol and also replaces all instances of symbol + space with just the symbol.
Finally, it replaces the symbol with the corresponding content of the arrCorrect, only if there are spaces in the rules though.
VB
Public Function AdjustSymbols(ByVal sInput As String) As String

    'Exit if the string does not contain any of the symbols
    If Not Contains(sInput, arrSymbols) Then
        AdjustSymbols = sInput
        Exit Function
    End If
    
    Dim sOut As String
    sOut = sInput
    Dim i As Integer
    For i = 1 To UBound(arrSymbols)
        If InStr(sOut, arrSymbols(i)) Then
            While InStr(sOut, " " + arrSymbols(i)) > 0
                sOut = Replace(sOut, " " + arrSymbols(i), arrSymbols(i))
            Wend
            While InStr(sOut, arrSymbols(i) + " ") > 0
                sOut = Replace(sOut, arrSymbols(i) + " ", arrSymbols(i))
            Wend
            If Not arrSymbols(i) = arrCorrect(i) Then
                sOut = Replace(sOut, arrSymbols(i), arrCorrect(i))
            End If
        End If
    Next
    
    AdjustSymbols = sOut
    
End Function
And an example from my testing
VB
Call SetUp   'Call on sheet load or similar

Dim aStringTest As String
aStringText = "i**!   _          (,."
Debug.Print "!" + AdjustSymbols(aStringText) + "!"
'Output is !i**!_(, . !
You would pass each cell that you want to consider into this function.
 
Share this answer
 
Comments
Maciej Los 4-May-17 1:28am    
5ed!

This content, along with any associated source code and files, is licensed under The Code Project Open License (CPOL)



CodeProject, 20 Bay Street, 11th Floor Toronto, Ontario, Canada M5J 2N8 +1 (416) 849-8900