title: How to delete certain characters using excel VBA script
body: <p>The following VBA script gets rid of unwanted characters but unfortunately only NUMBERS.</p>
  
  <p>Could you please assist me, It needs to rid letters too as in the table example(bolded) below.</p>
  
  <p>the Range could be anywhere from 0 to 15000+ cells</p>
  
  <p>.....................................................</p>
  
  <p><strong>a</strong> new <strong>a</strong> york <strong>a</strong> times <strong>a</strong></p>
  
  <p><strong>b</strong> new <strong>b</strong> york <strong>b</strong> times <strong>b</strong></p>
  
  <p><strong>c</strong> new <strong>c</strong> york <strong>c</strong> watertown <strong>c</strong> ny <strong>c</strong></p>
  
  <p><strong>6</strong> ave <strong>6</strong> new <strong>6</strong> york <strong>6</strong> city <strong>6</strong></p>
  
  <p>......................................................</p>
  
  <p>The VBA script:</p>
  
  <pre><code>Sub Remove()
  
  Application.ScreenUpdating = False
  Dim R As RegExp, C As Range
  For Each C In Range("A1:A" &amp; Cells(Rows.Count, 1).End(xlUp).Row)
  If R Is Nothing Then
  Set R = New RegExp
  R.Global = True
  R.Pattern = "\D"
  C.Offset(0, 1) = R.Replace(C, "")
  R.Pattern = "\d"
  C = R.Replace(C, "")
  End If
  Set R = Nothing
  Next C
  Application.ScreenUpdating = True
  End Sub
  </code></pre>
  
  <p><strong>EDIT1</strong></p>
  
  <pre><code>Sub Remove()
  Call BackMeUp
  
  Dim cell As Range
  Dim RE As Object
  Dim Whitecell As Range
  Dim strFind As String, strReplace As String
  Dim lLoop As Long
  Dim Loop1 As Long
  
      Application.ScreenUpdating = False
      Application.Calculation = xlCalculationManual
      Application.EnableEvents = False
  Range("A3:L3").Select
  Selection.Delete Shift:=xlUp
  '--------------------------------------------------Remove JUNK
  Range("A3:A" &amp; Cells(Rows.Count, 1).End(xlUp).Row).Select
  On Error Resume Next
  For lLoop = 1 To 100
      strFind = Choose(lLoop, "~?»", "~®", "~.", "~!", "~ï", "~-", "~§", "~$", "~%", "~&amp;", "~/", "~\", "~,", "~(", "~)", "~=", "~www", "~WWW", "~.com", "~.net", "~.org", "~{", "~}", "~[", "~]", "~ï", "~¿", "~½", "~:", "~;", "~_", "~µ", "~@", "~#", "~'", "~|", "~€", "~ä", "~ö", "~ü", "~Ä", "~Ü", "~Ö", "~+", "~&lt;", "~&gt;", "~nbsp", "~â", "~¦", "~©", "~Â", "~–", "~¼", "~?")
      strReplace = Choose(lLoop, " ")
  
      Selection.Replace What:=strFind, Replacement:=strReplace, LookAt:=xlPart, _
      SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
      ReplaceFormat:=False
  
  Next lLoop
  '--------------------------------------------------Remove Numbers
  Range("A3:A" &amp; Cells(Rows.Count, 1).End(xlUp).Row).Select
  On Error Resume Next
  For Loop1 = 1 To 40
      strFind = Choose(lLoop, "~1", "~2", "~3", "~4", "~5", "~6", "~7", "~8", "~9", "~0")
      strReplace = Choose(Loop1, " ")
  
      Selection.Replace What:=strFind, Replacement:=strReplace, LookAt:=xlPart, _
      SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
      ReplaceFormat:=False
  
  Next Loop1
  '--------------------------------------------------Remove Single Letters
  Set RE = CreateObject("vbscript.regexp")
  RE.Global = True
  RE.MultiLine = True
  RE.Pattern = "^[a-z]\b | \b[a-z]\b"
  
  For Each cell In Range("A3:A" &amp; Cells(Rows.Count, 1).End(xlUp).Row)
      cell.Value = RE.Replace(cell.Value, "")
  
  Next
  
  '--------------------------------------------------Remove WHITE SPACES
  
  For Each Whitecell In Range("A3:A" &amp; Cells(Rows.Count, 1).End(xlUp).Row)
      Whitecell = WorksheetFunction.Trim(Whitecell)
  Next Whitecell
  
  '--------------------------------------------------Remove DUPES
  
  ActiveSheet.Range("A3:A" &amp; Cells(Rows.Count, 1).End(xlUp).Row).RemoveDuplicates Columns:=1, Header:=xlYes
  ActiveWorkbook.Worksheets(ActiveSheet.Name).Sort.SortFields.Clear
  
  '--------------------------------------------------Copy to B - REPLACE ALL WHITE IN B
  
  Range("A3:A" &amp; Cells(Rows.Count, 1).End(xlUp).Row).Select
      Selection.Copy
      Range("B3:B" &amp; Cells(Rows.Count, 1).End(xlUp).Row).Select
      ActiveSheet.Paste
      Selection.Replace What:=" ", Replacement:="", LookAt:=xlPart, _
          SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
          ReplaceFormat:=False
          Columns("A:L").EntireColumn.AutoFit
  
  '--------------------------------------------------END
      Application.ScreenUpdating = True
      Application.Calculation = xlCalculationAutomatic
      Application.EnableEvents = True
      Range("a1").Select
  End Sub
  </code></pre>