Remove multiple spaces (VBA)

[simurq]

Here is the string (oCoord As String) I'm working on:

[COLOR=#ff0000]N[/COLOR]37[COLOR=#ff0000]°[/COLOR] 8[COLOR=#ff0000]'[/COLOR] 30.52[COLOR=#ff0000]"[/COLOR],[COLOR=#ff0000]W[/COLOR]107[COLOR=#ff0000]°[/COLOR] 45[COLOR=#ff0000]'[/COLOR] 46.92[COLOR=#ff0000]"[/COLOR],[COLOR=#ff0000]+[/COLOR]006682.00

Now, I want to modify it so that all characters highlighted in red are removed like this:

37 8 30.52,107 45 46.92,006682.00

The problem is when I'm looping through the string, the statement Mid(oCoord, i, 1) = "" {no space between the quotes} doesn't work at all while adding a single space between the quotes returns double spaces instead of removing the unneeded character. I tried Mid(oCoord, i, 1) = Replace(oCoord, Mid(oCoord, i, 1), "") but as a result I get ALL spaces removed.

PS: TRIM() function didn't help either!

        For i = 1 To Len(oCoord)
            sChar = Mid(oCoord, i, 1)
            Select Case True
            Case sChar = Chr(176)   ' degree sign " ° "
                Mid(oCoord, i, 1) = " "
            Case sChar = Chr(39)    ' single quote sign " ' "
                Mid(oCoord, i, 1) = " "
            Case sChar = Chr(34)    ' double quotes " "
                Mid(oCoord, i, 1) = " "
            Case sChar = Chr(43)    ' plus sign " + "
                Mid(oCoord, i, 1) = " "
            Case sChar = "N"
                Mid(oCoord, i, 1) = " "
            Case sChar = "E"
                Mid(oCoord, i, 1) = " "
            Case sChar = "S"
                Mid(oCoord, i, 1) = "-"
            Case sChar = "W"
                Mid(oCoord, i, 1) = "-"
            Case Else
            End Select
        Next

Can I get your assistance in this matter? Thank you very much in advance!!!

Rustam

 

[hurgadion]

Hi,
let Your, first String be in A1, then try using a code of the form:

Sub Replacce()
Dim i&, a As String

a = Cells(1, 1).Value
For i = 33 To 224
   If Abs(i - 45) <> 1 And Not Abs(i - 52.5) <= 4.5 Then
      a = Replace(a, Chr(i), "")
    End If
Next i

Cells(1, 2).Value = a
End Sub

Best regards.

 

[shg]

Or you could use a UDF:

Function simurq(sInp As String) As String
    Const sRep As String = "NESW'°+"""
    Dim i As Long
    
    simurq = sInp
    For i = 1 To Len(sRep)
        simurq = Replace(simurq, Mid(sRep, i, 1), "")
    Next i
End Function

      --------------------A--------------------- -------B------- C
  1   N37° 8' 30.52",W107° 45' 46.92",+006682.00                  
  2   37 8 30.52,107 45 46.92,006682.00          A2: =simurq(A1)

 

[simurq]

Thank you, SHG, that worked like a charm!

The most important lesson learned for me was looping through a string as an array: Const sRep As String = "NESW'°+"""

I've slightly modified your code though to account for S (South) and W (West) coordinates in which case instead of simply removing "S" or "W", the code now replaces these two chars with "-" (minus) sign.