Remove alphanumeric chars in front of a defined char-CodePudding

I have a string in a cell composed of several shorter strings of various lengths with blank spaces and commas in between. In some cases only one or more blanks are in between.

I want to remove every blank space and comma and only leave behind 1 comma between each string element. The result must look like this:

The following doesn't work. I'm not getting an error but the strings are truncated at the wrong places. I don't understand why.

Sub String_adaption()

Dim i, j, k, m As Long
Dim STR_A As String

STR_A = "01234567890ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"

i = 1

With Worksheets("table")

  For m = 1 To Len(.Range("H" & i))
  
      j = 1
      
    Do While Mid(.Range("H" & i), m, 1) = "," And Mid(.Range("H" & i), m - 1, 1) <> Mid(STR_A, j, 1) And m <> Len(.Range("H" & i))

            .Range("H" & i) = Mid(.Range("H" & i), 1, m - 2) & Mid(.Range("H" & i), m, Len(.Range("H" & i)))

            j = j   1
    Loop
             
  Next m

End With

End Sub

CodePudding user response：

The following function will split the input string into pieces (words), using a comma as separator. When the input string has multiple commas, it will result in empty words.
After splitting, the function loops over all words, trims them (remove leading and trailing blanks) and glue them together. Empty words will be skipped.

I have implemented it as Function, you could use it as UDF: If your input string is in B2, write =String_adaption(B2) as Formula into any cell.

Function String_adaption(s As String) As String
    ' Remove duplicate Commas and Leading and Trailing Blanks from words
    Dim words() As String, i As Long
    words = Split(s, ",")
    For i = 0 To UBound(words)
        Dim word As String
        word = Trim(words(i))
        If word <> "" Then
            String_adaption = String_adaption & IIf(String_adaption = "", "", ",") & word
        End If
    Next i
End Function

P.S.: Almost sure that this could be done with some magic regular expressions, but I'm not an expert in that.

CodePudding user response：

I'd use a regular expression to replace any combination of spaces and comma's. Something along these lines:

Sub Test()

Dim str As String: str = "STRING_22   ,,,,,STRING_1 ,  ,  ,,,,,STRING_333   STRING_22 STRING_4444"
Debug.Print RegexReplace(str, "[\s,] ", ",")

End Sub

Function RegexReplace(x_in, pat, repl) As String

With CreateObject("vbscript.regexp")
    .Global = True
    .Pattern = pat
    RegexReplace = .Replace(x_in, repl)
End With

End Function

Just for the sake of alternatives:

Formula in B1:

=TEXTJOIN(",",,TEXTSPLIT(A1,{" ",","}))

CodePudding user response：

This preserves the spaces within the smaller strings.

Option Explicit
Sub demo()
     Const s = "STRING 22,,,,   ,,STRING  1,,,,  ,,STRING  333 , , ,  STRING_22 STRING_44"
     Debug.Print Cleanup(s)
End Sub

Function Cleanup(s As String) As String

    Const SEP = ","
    Dim regex, m, sOut As String, i As Long, ar()
    Set regex = CreateObject("vbscript.regexp")
    With regex
        .Global = True
        .MultiLine = False
        .IgnoreCase = True
        .Pattern = "([^,] )(?:[ ,]*)"
    End With
    
    If regex.Test(s) Then
    
        Set m = regex.Execute(s)
        ReDim ar(0 To m.Count - 1)
        For i = 0 To UBound(ar)
           ar(i) = Trim(m(i).submatches(0))
        Next
        
    End If
    Cleanup = Join(ar, SEP)

End Function

CodePudding user response：

If you have recent Excel version, you can use simple worksheet function to split the string on space and on comma; then put it back together using the comma deliminater and ignoring the blanks (and I just noted @JvdV had previously posted the same formula solution):

=TEXTJOIN(",",TRUE,TEXTSPLIT(A1,{" ",","}))

In VBA, you can use a similar algorithm, using the ArrayList object to collect the non-blank results.

Option Explicit

Function commaOnly(s As String) As String
    Dim v, w, x, y
    Dim al As Object
    
Set al = CreateObject("System.Collections.ArrayList")

v = Split(s, " ")
For Each w In v
    x = Split(w, ",")
    For Each y In x
        If y <> "" Then al.Add y
    Next y
Next w

commaOnly = Join(al.toarray, ",")
    
End Function