?
Solved

Macro to remove spaces

Posted on 2016-07-14
14
Medium Priority
?
106 Views
Last Modified: 2016-07-14
Hello,
can you please help with an excel vba to remove spaces and format properly.
Example
COMPANY
STREET
City,   Q C   JOE 1E0

Should be
COMPANY      
STREET      
City, QC JOE1E0      ---- (City COMMA SPACE PROVINCE SPACE POSTALCODE)

Please see attached sample.
Any help is appreciated.
sample2.xlsx
0
Comment
Question by:W.E.B
  • 7
  • 4
  • 3
14 Comments
 
LVL 36

Expert Comment

by:Subodh Tiwari (Neeraj)
ID: 41711084
Try this....

Sub RemoveSpaces()
Columns("A:A").Replace What:="  ", Replacement:="", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False
End Sub

Open in new window

0
 

Author Comment

by:W.E.B
ID: 41711103
Hi Sudodh,
Thank you very muc,

Is it possible to add an if

if Adjacent cell in Column B = "Add to File"
then  do
Columns("A:A").Replace What:="  ", Replacement:="", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False

Thanks again,
0
 
LVL 55

Expert Comment

by:Rgonzo1971
ID: 41711121
Hi,

pls try

Sub macro()

For Each c In Range(Range("A2"), Range("A" & Rows.Count).End(xlUp))
strNewAddress = ""
    If c.Offset(, 1) = "Add to File" Then
        aAddress = Split(c, ",")
        For idx = 1 To Len(aAddress(1))
            strLetter = Mid(aAddress(1), idx, 1)
            If strLetter <> " " Then
                strNewAddress = strNewAddress & strLetter
            End If
        Next
        strNewAddress = " " & Left(strNewAddress, 2) & " " & Right(strNewAddress, Len(strNewAddress) - 3)
        aAddress(1) = strNewAddress
        c.Value = Join(aAddress, ",")
    End If
Next
End Sub

Open in new window

Regards
0
Free Tool: Subnet Calculator

The subnet calculator helps you design networks by taking an IP address and network mask and returning information such as network, broadcast address, and host range.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

 
LVL 36

Expert Comment

by:Subodh Tiwari (Neeraj)
ID: 41711141
Please try this......
Sub RemoveSpaces()
Dim lr As Long
Dim rng As Range, cell As Range
lr = Cells(Rows.Count, 2).End(xlUp).Row
On Error Resume Next
With ActiveSheet.Rows(1)
   .AutoFilter field:=2, Criteria1:="Add to File"
   If Range("B1:B" & lr).SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then
      Set rng = Range("A1:A" & lr).SpecialCells(xlCellTypeVisible)
      For Each cell In rng
         cell = WorksheetFunction.Trim(cell.Value)
      Next cell
   End If
   .AutoFilter
End With
End Sub

Open in new window

0
 
LVL 36

Expert Comment

by:Subodh Tiwari (Neeraj)
ID: 41711156
Please try this tweaked code.......
Sub RemoveSpaces()
Dim lr As Long
Dim rng As Range, cell As Range
lr = Cells(Rows.Count, 2).End(xlUp).Row
On Error Resume Next
With ActiveSheet.Rows(1)
   .AutoFilter field:=2, Criteria1:="Add to File"
   If Range("B1:B" & lr).SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then
      Set rng = Range("A1:A" & lr).SpecialCells(xlCellTypeVisible)
      For Each cell In rng
         cell = WorksheetFunction.Trim(cell.Value)
         cell = WorksheetFunction.Replace(cell.Value, InStrRev(cell.Value, " "), 1, "")
      Next cell
   End If
   .AutoFilter
End With
End Sub

Open in new window

0
 
LVL 55

Expert Comment

by:Rgonzo1971
ID: 41711164
pls try

Sub macro()

For Each c In Range(Range("A2"), Range("A" & Rows.Count).End(xlUp))
strNewAddress = ""
    If c.Offset(, 1) = "Add to File" Then
        aAddress = Split(c, ",")
        strNewAddress = Replace(aAddress(1), " ", "")
        strNewAddress = " " & Left(strNewAddress, 2) & " " & Right(strNewAddress, Len(strNewAddress) - 3)
        aAddress(1) = strNewAddress
        c.Value = Join(aAddress, ",")
    End If
Next
End Sub

Open in new window

0
 

Author Comment

by:W.E.B
ID: 41711178
Thank you ,
Rgonzo,

your code is trimming the left letter of the postal code.
Example
ANGEGARDIEN, QC JOE1E0
becomes
ANGEGARDIEN, QC OE1E0

Subodh
Your code is combining province with postalcode
CONTRECOEUR, QC  JOL 1CO
Becomes
CONTRECOEUR, QCJOL 1CO
0
 
LVL 36

Expert Comment

by:Subodh Tiwari (Neeraj)
ID: 41711183
Did you try my latest tweaked code?
It converts CONTRECOEUR, QC  JOL 1CO into CONTRECOEUR, QC  JOL1CO
0
 

Author Comment

by:W.E.B
ID: 41711197
Hi Sudobh,
I just tried the tweaked code

ROUYNNORANDA,   QC   J9X5E4
Becomes
ROUYNNORANDA, QCJ9X5E4
0
 
LVL 36

Expert Comment

by:Subodh Tiwari (Neeraj)
ID: 41711227
Okay give it a try...

Sub RemoveSpaces()
Dim lr As Long
Dim rng As Range, cell As Range
lr = Cells(Rows.Count, 2).End(xlUp).Row
On Error Resume Next
With ActiveSheet.Rows(1)
   .AutoFilter field:=2, Criteria1:="Add to File"
   If Range("B1:B" & lr).SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then
      Set rng = Range("A1:A" & lr).SpecialCells(xlCellTypeVisible)
      For Each cell In rng
         If cell <> "" Then
            cell = Replace(cell.Value, Chr(160), " ")
            Do While InStr(cell.Value, "  ") > 0
               cell = Replace(cell.Value, "  ", " ")
            Loop

            If InStr(Right(cell.Value, 6), " ") <> 0 Then
               cell = WorksheetFunction.Replace(cell.Value, InStrRev(cell.Value, " "), 1, "")
            End If
         End If
      Next cell
   End If
   .AutoFilter
End With
End Sub

Open in new window

0
 
LVL 36

Accepted Solution

by:
Subodh Tiwari (Neeraj) earned 1000 total points
ID: 41711240
I have tweaked the code again. :)

Please try the code given below.....
Sub RemoveSpaces()
Dim lr As Long
Dim rng As Range, cell As Range
lr = Cells(Rows.Count, 2).End(xlUp).Row
On Error Resume Next
With ActiveSheet.Rows(1)
   .AutoFilter field:=2, Criteria1:="Add to File"
   If Range("B1:B" & lr).SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then
      Set rng = Range("A1:A" & lr).SpecialCells(xlCellTypeVisible)
      For Each cell In rng
         If cell <> "" Then
            cell = Replace(cell.Value, Chr(160), " ")
            Do While InStr(cell.Value, "  ") > 0
               cell = Replace(cell.Value, "  ", " ")
            Loop
            cell = WorksheetFunction.Trim(cell.Value)
            If InStr(Right(cell.Value, 6), " ") <> 0 Then
               cell = WorksheetFunction.Replace(cell.Value, InStrRev(cell.Value, " "), 1, "")
            End If
         End If
      Next cell
   End If
   .AutoFilter
End With
End Sub

Open in new window

0
 
LVL 55

Assisted Solution

by:Rgonzo1971
Rgonzo1971 earned 1000 total points
ID: 41711350
then
trySub macro()

For Each c In Range(Range("A2"), Range("A" & Rows.Count).End(xlUp))
strNewAddress = ""
    If c.Offset(, 1) = "Add to File" Then
        aAddress = Split(c, ",")
        For idx = 1 To Len(aAddress(1))
            strLetter = Mid(aAddress(1), idx, 1)
            If strLetter <> " " Then
                strNewAddress = strNewAddress & strLetter
            End If
        Next
        strNewAddress = " " & Left(strNewAddress, 2) & " " & Right(strNewAddress, Len(strNewAddress) - 2)
        aAddress(1) = strNewAddress
        c.Value = Join(aAddress, ",")
    End If
Next
End Sub

Open in new window

0
 

Author Closing Comment

by:W.E.B
ID: 41711424
Thank you very much guys.
Both worked.
0
 
LVL 36

Expert Comment

by:Subodh Tiwari (Neeraj)
ID: 41711671
You're welcome. Glad to help.
0

Featured Post

Free Tool: Path Explorer

An intuitive utility to help find the CSS path to UI elements on a webpage. These paths are used frequently in a variety of front-end development and QA automation tasks.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

As a person who answers a lot of questions, I often see code that could be simplified, made easier to read, and perhaps most importantly made easier to maintain if the code was modified to use the Select Case statement. This article explains how to…
This is a comprehensive review of a bundled Toolkit designed for use by IT Professionals and End Users to help Microsoft Outlook fans manipulate Outlook files and repair some common problems. Enjoy...
Excel styles will make formatting consistent and let you apply and change formatting faster. In this tutorial, you'll learn how to use Excel's built-in styles, how to modify styles, and how to create your own. You'll also learn how to use your custo…
Access reports are powerful and flexible. Learn how to create a query and then a grouped report using the wizard. Modify the report design after the wizard is done to make it look better. There will be another video to explain how to put the final p…

589 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question