vba How to insert space removing double line

user_14451403 0
Viewed 59

How am i able to add a space after a certain Pattern

Example: DS9 DS10DS11 DS12
Result: DS9 DS10 DS11 DS12

Example 2: C1 C2 C3C4 C5
Result: C1 C2 C3 C4 C5

Before I get the example, I use a CleanTrim function to remove the double line

Function CleanTrim(ByVal S As String, Optional ConvertNonBreakingSpace As Boolean = True) As String
  Dim X As Long, CodesToClean As Variant
  CodesToClean = Array(0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, _
                       21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 127, 129, 141, 143, 144, 157)
  If ConvertNonBreakingSpace Then S = Replace(S, Chr(160), " ")
  For X = LBound(CodesToClean) To UBound(CodesToClean)
    If InStr(S, Chr(CodesToClean(X))) Then S = Replace(S, Chr(CodesToClean(X)), "")
  Next
  CleanTrim = WorksheetFunction.Trim(S)
End Function

I want to be able to split the String using a Space Delimiter but there are some wording there does not have any space.

I have consider using the Addspace function which add a space in front of a capital letter. but in the event where there is 2 capital letter. There will be 2 spaces

Function Add_Spaces(ByVal sText As String) As String
   Dim CharNum As Long
   Dim FixedText As String
   Dim CharCode As Long

   FixedText = Left(sText, 1)

   For CharNum = 2 To Len(sText)
      CharCode = Asc(Mid(sText, CharNum, 1))
      If CharCode >= 65 And CharCode <= 90 Then
         FixedText = FixedText & " " & Mid(sText, CharNum, 1)
      Else
         FixedText = FixedText & Mid(sText, CharNum, 1)
      End If
   Next CharNum

   Add_Spaces = FixedText
End Function
vba excel
2 Answers

I suggest to remove all the spaces, then add a space at each transition between a digit and a letter.

I used an ArrayList to collect and space the data:

Option Explicit
Function spaceRegular(S As String) As String
    Dim str As String, char As String * 1
    Dim AL As Object, I As Long
    
Set AL = CreateObject("System.Collections.ArrayList")
str = Replace(S, " ", "")

'read string into ArrayList, adding a space at the transition
For I = 1 To Len(str)
    char = Mid(str, I)
    If I = 1 Then
        AL.Add char
    Else
        If AL.Item(AL.Count - 1) Like "[0-9]" And _
            char Like "[A-Z]" Then
            AL.Add Space(1)
        End If
        AL.Add char
    End If
Next I

spaceRegular = Join(AL.toarray, "")
    
End Function

enter image description here

And here is a method using the Replace method of the Regular Expression object:

Function spaceRegular2(S As String) As String
    Dim RE As Object
    Const sPat As String = "([0-9])([A-Z])"
    Const sRepl As String = "$1 $2"
    
Set RE = CreateObject("vbscript.regexp")
With RE
    .Global = True
    .ignorecase = False
    .Pattern = sPat
    spaceRegular2 = .Replace(S, sRepl)
End With
End Function
user_28729220

Here is code using the RegEx object.

Function AddSpaces(ByVal Original As String) As String

    Dim Fun()        As String              ' function return array
    Dim Matches     As Variant
    Dim Match       As Variant
    Dim i           As Integer              ' loop counter: Matches(index)

    Dim RegEx       As Object
   Set regex = CreateObject("VBScript.RegExp")
'    Dim RegEx       As RegExp               ' Microsoft VBScript Regular Expressions library
'    Set RegEx = New RegExp
    
    With RegEx
        .Pattern = "[A-Z]+[0-9]+"
        .Global = True
        Set Matches = .Execute(Original)
    End With
    
    ReDim Fun(1 To Matches.Count)
    For Each Match In Matches
        i = i + 1
        Fun(i) = Match
    Next Match

    AddSpaces = Join(Fun)
End Function

The RegEx object is in the Microsoft VBScript Regular Expressions library which you have to enabler if you want the benefit of Intellisense guidance. If you don't want to go to the trouble declare RegEx As Object and create the object on the fly. I have added the syntax for both. Remove the one you don't want to use.

The function first creates a collection of matches, then converts this to an array and, finally, joins the array into a string. You could assign that string to the Value property of a cell. But if you have other plans it may be better to modify the function to return one of the results it discards on the way.

Here is the code I used for testing my function.

Private Sub TestAdSpaces()
    Debug.Print AddSpaces("DS9 DS10DS11 DS12")
    Debug.Print AddSpaces("C1 C2 C3C4 C5")
End Sub
user_76754370
Related