VBA: Use Replace to Remove space, comma, dash from Strings

A

AlexB123

Board Regular
Joined
Dec 19, 2014
Messages
207
Hi all,

I am updating an old macro and trying to use the replace function instead of two nested loops that process every character in the columns to remove all spaces, commas and dashes in the strings (addresses). My macro runs but does not replace anything. At the moment, I can get neither approach to work. Any help or suggestions is appreciated!

New:

Code: 
i = 3
        Do Until i = lastrowSh3 + 1
                
            mainSh3.Range("C" & i).Value = Replace(mainSh3.Range("C" & i).Value, " ", "")
            mainSh3.Range("C" & i).Value = Replace(mainSh3.Range("C" & i).Value, "-", "")
            mainSh3.Range("C" & i).Value = Replace(mainSh3.Range("C" & i).Value, ",", "")
                
If mainSh3.Range("C" & i) = 0 Then mainSh3.Range("D" & i).Value = ""
            
            mainSh3.Range("D" & i).Value = Replace(mainSh3.Range("D" & i).Value, " ", "")
            mainSh3.Range("D" & i).Value = Replace(mainSh3.Range("D" & i).Value, "-", "")
            mainSh3.Range("D" & i).Value = Replace(mainSh3.Range("D" & i).Value, ",", "")
            
            i = i + 1
        Loop

original:
Code: 
remove extra characters
        i = 3
        Do Until i = lastrowSh3 + 1
           strString = mainSh3.Range("C" & i).Value
            strOut = ""
                If IsError(strString) Then GoTo SkipCell
                    For lngLoop = 1 To Len(strString)
                        If (Mid(strString, lngLoop, 1) <> " ") And (Mid(strString, lngLoop, 1) <> "-") And (Mid(strString, lngLoop, 1) <> ",") Then
                            strOut = strOut & Mid(strString, lngLoop, 1)
                        End If
                    Next
                mainSh3.Range("C" & i).Value = strOut
            If mainSh3.Range("C" & i) = 0 Then mainSh3.Range("D" & i).Value = ""
SkipCell:
        i = i + 1
        Loop
        
        i = 2
        Do Until i = lastrowSh3 + 1
            strString = mainSh3.Range("D" & i).Value
            strOut = ""
                If IsError(strString) Then GoTo SkipCell2
                    For lngLoop = 1 To Len(strString)
                        If (Mid(strString, lngLoop, 1) <> " ") And (Mid(strString, lngLoop, 1) <> "-") And (Mid(strString, lngLoop, 1) <> ",") Then
                           strOut = strOut & Mid(strString, lngLoop, 1)
                       End If
                    Next
            mainSh3.Range("D" & i).Value = strOut
            If mainSh3.Range("D" & i) = 0 Then mainSh3.Range("D" & i).Value = ""
           
        SkipCell2:
        i = i + 1
        Loop
 

Excel Facts

Get help while writing formula
Click the italics "fx" icon to the left of the formula bar to open the Functions Arguments dialog. Help is displayed for each argument.
Sort by date Sort by votes
How about
Code: 
   Dim i As Long
   Dim Ary As Variant
   
   Ary = Array(" ", "-", ",")
   For i = 0 To UBound(Ary)
      mainsh3.Range("C3:D" & lastrowSh3).Replace Ary(i), "", xlPart, , , , False, False
   Next i
 
Upvote 0
What was the value of lastrowSh3, when you ran it?
 
Upvote 0
I set a breakpoint at the end of the code, and according to my locals window, the value is 2.

There is a line that uses autofilter to remove all the rows with the tag "REMOVE". But on the data I'm using, there are none to be removed, so I don't know why the lastrowSh3 isn't working?

Prior to this line the value of lastrowSh3 is 1953.

Code: 
Option Base 1
Public Sub CompPREPAYTQ()
    Application.DisplayAlerts = False
     
    Dim tqLong, prepayLong As String
    Dim macroWB, mainWB, prepayWB, tqWB As Workbook
    Dim mainSh1, mainSh2, mainSh3, tqSh1, tqSh2, tqSh3, prepaySh1, macroSh1 As Worksheet
    Dim tpsUserCount As Integer
    Dim dayCount1 As Long
    Dim dayCount2 As Double
    Dim lastrowMacSh As Integer: lastrowMacSh = 0
    Dim lastrowSh2 As Integer: lastrowSh2 = 0
    Dim lastrowSh3 As Integer: lastrowSh3 = 0
    Dim tpsUsers As Variant
    Dim sort1, sort2, sort3, sort4 As Range
    Dim prepRng, tqRng As Range
    Dim archivePath1 As String
    Dim archivePath2 As String
    Dim archivePath3 As String
    Dim bkName, fileStr, fileName As String
        archivePath1 = "C:\Alex\Documents\"
        archivePath2 = archivePath1 & Year(Now) & " " & "Reviewed\"
        archivePath3 = archivePath2 & MonthName(Month(Now)) & "\"
                
            Call CheckForPaths(archivePath1, archivePath2)
            Call CheckOnePath(archivePath3)
        
                'Ask the user which report they are uploading
                bkName = InputBox(Prompt:="Please input either ""TQ41"" or ""TQ46"".", _
                    Title:="Which report?")
                        
                    If bkName <> "TQ41" And bkName <> "TQ46" Then
                        MsgBox "Please enter either ""TQ41"" or ""TQ46"" in to the message box!"
                        Exit Sub
                    End If
             
        fileStr = "REVIEWED_" & Format(Date - 1, "MMDDYYYY") & "_" & Format(Date, "MMDDYYYY") & " " & bkName & ".xlsx"
        fileName = archivePath3 & fileStr
    
    Set macroWB = ThisWorkbook
    Set mainWB = Workbooks.Add
    mainWB.Sheets.Add After:=Sheet1, Count:=2
    
        Set macroSh1 = macroWB.Sheets(1)
        Set mainSh1 = mainWB.Sheets(1)
        Set mainSh2 = mainWB.Sheets(2)
        Set mainSh3 = mainWB.Sheets(3)
            mainSh1.Name = "Results"
            mainSh2.Name = "Prepayment Report"
            mainSh3.Name = "TQ Report"
    
    lastrowMacSh = macroSh1.Rows.Range("b65536").End(xlUp).Row
    
    tpsUserCount = lastrowMacSh - 1
    tpsUsers = macroSh1.Range("B2:B" & lastrowMacSh)
    
        MsgBox ("Locate and select the PREPAYMENT REPORT.")
            Application.FileDialog(msoFileDialogOpen).Show
            prepayLong = Application.FileDialog(msoFileDialogOpen).SelectedItems(1)
                If IsNull(prepayLong) Or prepayLong = "" Then Exit Sub
        
        MsgBox ("Next, locate and select the TQ REPORT.")
            Application.FileDialog(msoFileDialogOpen).Show
            tqLong = Application.FileDialog(msoFileDialogOpen).SelectedItems(1)
                If IsNull(tqLong) Or tqLong = "" Then Exit Sub
        
    Set prepayWB = Workbooks.Open(prepayLong)
    Set prepaySh1 = prepayWB.Sheets(1)
        
        prepaySh1.Cells.Copy
        mainSh2.Range("A1").PasteSpecial
        mainSh2.Columns("A:A").Insert Shift:=xlToRight
        
        prepayWB.Close True
        Application.DisplayAlerts = False
    Set tqWB = Workbooks.Open(tqLong)
    Set tqSh1 = tqWB.Sheets(1)
    
        tqSh1.Cells.Copy
        mainSh3.Range("A1").PasteSpecial
        mainSh3.Columns("A:D").Insert Shift:=xlToRight
        
            mainSh3.Range("A2").Value = "Match?"
            mainSh3.Range("B2").Value = "UID"
            mainSh3.Range("C2").Value = "TQReport"
            mainSh3.Range("D2").Value = "PrepayRpt"
    
        tqWB.Close True
        Application.DisplayAlerts = False
    
    lastrowSh2 = mainSh2.Rows.Range("b65536").End(xlUp).Row
    mainSh2.Range("A2").Formula = "=RIGHT(""00000000""&trim(D2),8)&RIGHT(""000000000""&trim(E2),9)"
    mainSh2.Range("A2").Copy
    mainSh2.Range("A3:A" & lastrowSh2).PasteSpecial xlPasteAll
    
    lastrowSh3 = mainSh3.Rows.Range("e65536").End(xlUp).Row
    mainSh3.Range("A3").Formula = "=IFERROR(IF(C3=D3,""Match"",""No Match!""),""No Match!"")"
    mainSh3.Range("B3").Formula = "=RIGHT(""00000000""&trim(E3),8)&RIGHT(""000000000""&trim(F3),9)"
    mainSh3.Range("C3").Formula = "=trim(J3)"
    mainSh3.Range("A3:C3").Copy
    mainSh3.Range("A4:C" & lastrowSh3).PasteSpecial xlPasteAll
    mainSh3.Range("C3:C" & lastrowSh3).Copy
    mainSh3.Range("C3:C" & lastrowSh3).PasteSpecial xlPasteValues
    mainSh3.Range("Q3:Q" & lastrowSh3).Value = "REMOVE"
    
        i = 3
        Do Until i = lastrowSh3 + 1
            j = 1
            Do Until j = tpsUserCount
                If Trim(mainSh3.Range("N" & i).Value) = Trim(tpsUsers(j, 1)) Then mainSh3.Range("Q" & i).Value = Null
                j = j + 1
            Loop
    If Trim(mainSh3.Range("H" & i).Value) = "PARTICIPANT NAME" Then mainSh3.Range("D" & i).Formula = "="""" & VLOOKUP(B" & i & ",'Prepayment Report'!A:AG,7,FALSE)"
    If Trim(mainSh3.Range("H" & i).Value) = "IN CARE OF" Then mainSh3.Range("D" & i).Formula = "="""" & VLOOKUP(B" & i & ",'Prepayment Report'!A:AG,8,FALSE)"
    If Trim(mainSh3.Range("H" & i).Value) = "ADDRESS LINE 1" Then mainSh3.Range("D" & i).Formula = "="""" & VLOOKUP(B" & i & ",'Prepayment Report'!A:AG,9,FALSE)"
    If Trim(mainSh3.Range("H" & i).Value) = "ADDRESS LINE 2" Then mainSh3.Range("D" & i).Formula = "="""" & VLOOKUP(B" & i & ",'Prepayment Report'!A:AG,10,FALSE)"
    If Trim(mainSh3.Range("H" & i).Value) = "FINANCIAL INSTITUTN" Then mainSh3.Range("D" & i).Formula = "="""" & VLOOKUP(B" & i & ",'Prepayment Report'!A:AG,17,FALSE)"
    If Trim(mainSh3.Range("H" & i).Value) = "FOR BENEFIT OF" Then mainSh3.Range("D" & i).Formula = "="""" & VLOOKUP(B" & i & ",'Prepayment Report'!A:AG,18,FALSE)"
    If Trim(mainSh3.Range("H" & i).Value) = "ALT PAYEE ADDR LINE1" Then mainSh3.Range("D" & i).Formula = "="""" & VLOOKUP(B" & i & ",'Prepayment Report'!A:AG,19,FALSE)"
    If Trim(mainSh3.Range("H" & i).Value) = "ALT PAYEE ADDR LINE2" Then mainSh3.Range("D" & i).Formula = "="""" & VLOOKUP(B" & i & ",'Prepayment Report'!A:AG,20,FALSE)"
            i = i + 1
        Loop
    
    mainSh3.Range("D3:D" & lastrowSh3).Copy
    mainSh3.Range("D3:D" & lastrowSh3).PasteSpecial xlPasteValues
    'remove unwanted TPS users
        With mainSh3
            .AutoFilterMode = False
            .Range("A2:Q2").AutoFilter _
            Field:=17, Criteria1:="=REMOVE"
        End With
    
            lastrowSh3 = mainSh3.Rows.Range("q65536").End(xlUp).Row
            mainSh3.Rows("3:" & lastrowSh3).Delete Shift:=xlUp
            lastrowSh3 = mainSh3.Rows.Range("e65536").End(xlUp).Row
          
        mainSh3.AutoFilterMode = False
    
        'remove extra characters
        Set prepRng = mainSh3.Range("C3:C" & lastrowSh3)
        Set tqRng = mainSh3.Range("D3:D" & lastrowSh3)
        
        
        Dim k As Long
        Dim Ary As Variant
            Ary = Array(" ", "-", ",")
            For k = 1 To UBound(Ary)
                mainSh3.Range("C3:D" & lastrowSh3).Replace Ary(k), "", xlPart, , , , False, False
            Next k
    
        'sort
        Set sort1 = Range("A2:Q2")
        Set sort2 = Range("A2")
        Set sort3 = Range("E2")
        Set sort4 = Range("F2")
            
            With mainSh3.Sort
                .SortFields.Add Key:=sort2, Order:=xlDescending
                .SortFields.Add Key:=sort3, Order:=xlDescending
                .SortFields.Add Key:=sort4, Order:=xlDescending
                .SetRange sort1
                .Header = xlYes
                .Apply
            End With
            
            With mainSh3
                 .AutoFilterMode = False
                 .Range("A2:Q2").AutoFilter
                 .Range("A2:Q2").AutoFilter _
                 Field:=1, Criteria1:="=Match"
             End With
      
    mainSh3.Columns("B:B").EntireColumn.Hidden = True
       
    mainSh1.Range("A2").Value = "# Matches"
    mainSh1.Range("A3").Value = "# W/O Matches"
    mainSh1.Range("B1").Value = "Results"
    mainSh1.Range("B2").Formula = "=COUNTIF('TQ Report'!A:A,""Match"")"
    mainSh1.Range("B3").Formula = "=COUNTIF('TQ Report'!A:A,""No Match!"")"
    mainSh1.Range("A1:B1,A2:A3").Font.Bold = True
    mainSh1.Cells.EntireColumn.AutoFit
    
    mainWB.SaveAs fileName
    
    Application.DisplayAlerts = True
    MsgBox "Done!"
    
End Sub
 
Upvote 0
Swap these 2 lines round
Code: 
lastrowSh3 = mainSh3.Rows.Range("e65536").End(xlUp).Row
          
        mainSh3.AutoFilterMode = False
If there is nothing visible with the autofilter, then the last row will be row 2
 
Upvote 0
Glad to help & thanks for the feedback
 
Upvote 0
You must log in or register to reply here.

Similar threads

tourless
  • Question
Capture and remove last two in a string
Replies
3
Views
488
duggie33
D
K
  • Solved
Combining 3 Worksheet_Change events
Replies
4
Views
295
Kevo
K
B
  • Question
How do i open a csv file created in excel and do a find and replace of this file and save as a new file without strange characters ??
Replies
1
Views
616
Special-K99
S
M
  • Question
VBA Code - Run Code if cell value is not blank
Replies
0
Views
433
MHamid
M
R
  • Question
How to combine the functions of having the ability to select multiple items from a drop down list and hide columns based on values of said list?
Replies
0
Views
216
rgree05
R

Forum statistics

Threads
1,214,851
Messages
6,121,931
Members
449,056
Latest member
denissimo

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top