Convert single string into multiple lines of 1024 or some set max

[bradyboyy88]

Hi!

I have some very long sql code that I want to convert into clean lines of 1024 which I can then copy and paste into my vba editor. So I have a userform where i paste the sql code that is in multiple line form and a second textbox which outputs the vba ready code. However, I want to keep the max line under some set amount which we could say is 1000 just to be safe but I did not want to break words up since spaces and new lines can sometimes be weird in SQL. Basically at the 1000th character I want to start looking at the next occurance of a space then insert in a new line break there then start looking again at the next 1000th character set to do the same until I have looped through all the string and now converted into x many rows of 1000 characters. Here is what I have so far but keep getting hung up on how to do this.

Option Explicit


Private Sub CommandButton1_Click()
    Dim Str As String
    Dim FinalStr As String
    Dim n As Long
    Dim MaxLength As Long
    
    MaxLength = 900
    Str = TextBox1.Text
    
    If Len(Str) = 0 Then
        Exit Sub
    Else
        Str = Replace(Replace(TextBox1.Text, vbLf, " "), vbCr, " ")
        For n = MaxLength To Len(Str)
            FinalStr = Replace(Str, " ", " " & vbCr & " ", InStr(MaxLength, Str, " "), InStr(MaxLength, Str, " "))
            n = n + MaxLength
        Next
        TextBox2.Text = FinalStr
    End If


End Sub

 

[JoeMo]

Lightly tested, but if this works for you, maybe you can adapt it to your button/textbox code. Basically, it splits the input text into individual words and their non-space punctuation, if any, then rebuilds them into lines whose character length is as close as possible to the desired maximum which is adjustable.

Sub LinesOfLengthN()
Dim Sin As String, Vin As Variant, i As Long, Sout As String, Vout As Variant, ct As Long
Const N As Long = 1000  'adjust to suit
ActiveSheet.Shapes("TextBox 3").Select
Sin = Selection.Text
Vin = Split(Sin, " ")
ReDim Vout(1 To UBound(Vin) + 1)
For i = LBound(Vin) To UBound(Vin)
    If Len(Sout & Vin(i) & " ") > Length Then
        i = i - 1
        ct = ct + 1
        Vout(ct) = Sout
        Sout = ""
    Else
        Sout = Sout & Vin(i) & " "
    End If
Next i
If Sout <> "" Then
    ct = ct + 1
    Vout(ct) = Sout
    Sout = ""
End If
'your code to process the variable array Vout whose elements contain individual lines meeting the <=
'max length N here
MsgBox Trim(Join(Vout, vbCrLf))
End Sub

 

[JoeMo]

Sorry, I changed the constant I initially called "Length" to "N" and forgot to replace it. Here's the modified code using N.

Sub LinesOfLengthN()
Dim Sin As String, Vin As Variant, i As Long, Sout As String, Vout As Variant, ct As Long
Const N As Long = 100  'adjust to suit
ActiveSheet.Shapes("TextBox 3").Select
Sin = Selection.Text
Vin = Split(Sin, " ")
ReDim Vout(1 To UBound(Vin) + 1)
For i = LBound(Vin) To UBound(Vin)
    If Len(Sout & Vin(i) & " ") > N Then
        i = i - 1
        ct = ct + 1
        Vout(ct) = Sout
        Sout = ""
    Else
        Sout = Sout & Vin(i) & " "
    End If
Next i
If Sout <> "" Then
    ct = ct + 1
    Vout(ct) = Sout
    Sout = ""
End If
'your code to process the variable array Vout whose elements contain individual lines meeting the <=
'max length N here
MsgBox Trim(Join(Vout, vbCrLf))
End Sub

 

[bradyboyy88]

Thanks for the code. I hit script out of range at Vout(ct) = Sout . When I hover over Sout its value is "" which is strange.

 

[JoeMo]

Thanks for the code. I hit script out of range at Vout(ct) = Sout . When I hover over Sout its value is "" which is strange.

That's not enough information to diagnose the problem. Need to know what the values of ct and Ubound(Vin) are when you get the error. If you can you post the text that's used as the input, that would also be helpful.

 

[Rick Rothstein]

Does this code work for you...

Function WrapText(S As String, MaxChars) As String
  Dim Space As Long, Text As String, TextMax As String
  Text = S
  Do While Len(Text) > MaxChars
    TextMax = Left(Text, MaxChars + 1)
    If Right(TextMax, 1) = " " Then
      WrapText = WrapText & RTrim(TextMax) & vbLf
      Text = Mid(Text, MaxChars + 2)
    Else
      Space = InStrRev(TextMax, " ")
      If Space = 0 Then
        WrapText = WrapText & Left(Text, MaxChars) & vbLf
        Text = Mid(Text, MaxChars + 1)
      Else
        WrapText = WrapText & Left(TextMax, Space - 1) & vbLf
        Text = Mid(Text, Space + 1)
      End If
    End If
  Loop
  WrapText = WrapText & Text
End Function

The function takes two arguments... the first is the original text and the second is the maximum number of characters per line.