Creating a block of string that centers itself with spaces

[bradyboyy88]

I am trying to figure out some way to take a string and make sure its a certain number of characters (I would say width but that would be much more involved given characters and point sizes are so confusing!!!) and center it via spaces. For instance, if I have a string "cat" but I want it to have 7 characters then I have " Cat ". Does the format function have way of doing this?

 

[rlv01]

I don't think format will center text like that, but a VBA UDF to do it is possible

Function CenterText(MyStr As String, FieldWidth As Long) As String
    Dim L, R


    If Len(MyStr) < FieldWidth Then
        L = Int((FieldWidth - Len(MyStr)) / 2)
        R = FieldWidth - L
        CenterText = Space(L) & MyStr & Space(R)
    Else
        CenterText = MyStr
    End If
End Function

 

[bradyboyy88]

I don't think format will center text like that, but a VBA UDF to do it is possible

Function CenterText(MyStr As String, FieldWidth As Long) As String
    Dim L, R


    If Len(MyStr) < FieldWidth Then
        L = Int((FieldWidth - Len(MyStr)) / 2)
        R = FieldWidth - L
        CenterText = Space(L) & MyStr & Space(R)
    Else
        CenterText = MyStr
    End If
End Function

Thats a clean solution and gets the job done! Thanks!

 

[Rick Rothstein]

Here is another way to write the function that you might find interesting (note my use of Mid as a statement on the left side of the equal sign)...

Function CenterText(MyStr As String, FieldWidth As Long) As String
  CenterText = Space(FieldWidth)
  If Len(MyStr) < FieldWidth Then
    Mid(CenterText, 1 + Int((FieldWidth - Len(MyStr)) / 2)) = MyStr
  Else
    CenterText = MyStr
  End If
End Function

 

[bradyboyy88]

Thanks Rick!

There is one other thing to this function that would be interesting. Basically I have numerous strings that are to be written out in a column form and need to be centered as shown below:

Column1 Column2 Column3
test test test

So the code in theory looks like this:

String1= CenterText("Column1",9) & " " & CenterText("Column2",9) & " " & CenterText("Column3",9)
String2= CenterText("Test",9) & " " &  CenterText("Test",9) & " " &  CenterText("Test",9)

Debug.Print String1
Debug.Print String2

Basically I want to keep 1 entire row of text as its own string. The reason being is I am dynamically creating rows in a userform and dynamically creating rows and multiple columns gets very very slow (row x column). So by cutting dynamic label down to one string/one (rows * 1 column) label speeds my code up A LOT. So any help on this is great. The issues I am having with the code above is that spaces and characters are not all equal width so it can throw off what is truly "centered" on the screen especially depending on the font. The second thing is when reaching the maximum length of that then it would be great to allow a second line with maybe vbnewline as shown below. This may be hard to do unless all the mini strings are passed to the CenterText function and a more complex algorithm is applied. I am baffled how to achieve this and I should have probably put this in the original post!!


Column1 Column2 Column3
test test,test test
test

 

[bradyboyy88]

Just realized it removes my spaces. But hopefully you get the point that I am trying to make where it pre centers the first and second line under the appropriate columns.

 

[rlv01]

..and need to be centered as shown below:

Column1 Column2 Column3
test test test

Oops! I just realized I somehow posted code from an earlier version I was playing with that had a mistake, which might have messed you up. Here's the correct version

Function CenterText(MyStr As String, FieldWidth As Long) As String
    Dim L, R

    If Len(MyStr) < FieldWidth Then
        L = Int((FieldWidth - Len(MyStr)) / 2)
        R = FieldWidth - (L + Len(MyStr)) '<- correction
        CenterText = Space(L) & MyStr & Space(R)
    Else
        CenterText = MyStr
    End If
End Function

Sorry about that. If you are using a non-proportional font like Courier New then

String1 = CenterText1("Column1", 9) & " " & CenterText1("Column2", 9) & " " & CenterText1("Column3", 9)
String2 = CenterText1("Test", 9) & " " & CenterText1("Test", 9) & " " & CenterText1("Test", 9)

Should reasonably center the text

 Column1   Column2   Column3 
  Test      Test      Test

But as you noticed, with a proportional font it can look funny:
Column1 Column2 Column3
Test Test Test

With a proportional font, sometimes if the strings are relatively short, using tabs instead of spaces can work.

String1 = CenterText("Column1", 9) & Chr(9) & CenterText("Column2", 9) & Chr(9) & CenterText("Column3", 9)
String2 = CenterText("Test", 9) & Chr(9) & CenterText("Test", 9) & Chr(9) & CenterText("Test", 9)

As far as creating a new line if your string runs long, I'm not sure I understand what you are trying to do.

 

[bradyboyy88]

First off thanks for the update to the previous code. I should be able to try that out later today to see how the positioning works out. In regards to the new line concept, basically the following shown below. I am not sure of the best way to approach this but I am thinking it would require a parent function using your center text methodology passing a string array and checking if each index has a length greater than the max character width set in your center function and if it is then it starts a new line after it check all components to know if it should add all spaces for each column or the next section of text. Does that make sense?

 Column1      Column2       Column3 
   Test      Test,test,       Test
                test

 

[bradyboyy88]

Oops! I just realized I somehow posted code from an earlier version I was playing with that had a mistake, which might have messed you up. Here's the correct version

Function CenterText(MyStr As String, FieldWidth As Long) As String
    Dim L, R

    If Len(MyStr) < FieldWidth Then
        L = Int((FieldWidth - Len(MyStr)) / 2)
        R = FieldWidth - (L + Len(MyStr)) '<- correction
        CenterText = Space(L) & MyStr & Space(R)
    Else
        CenterText = MyStr
    End If
End Function

Sorry about that. If you are using a non-proportional font like Courier New then

String1 = CenterText1("Column1", 9) & " " & CenterText1("Column2", 9) & " " & CenterText1("Column3", 9)
String2 = CenterText1("Test", 9) & " " & CenterText1("Test", 9) & " " & CenterText1("Test", 9)

Should reasonably center the text

 Column1   Column2   Column3 
  Test      Test      Test

But as you noticed, with a proportional font it can look funny:
Column1 Column2 Column3
Test Test Test

With a proportional font, sometimes if the strings are relatively short, using tabs instead of spaces can work.

String1 = CenterText("Column1", 9) & Chr(9) & CenterText("Column2", 9) & Chr(9) & CenterText("Column3", 9)
String2 = CenterText("Test", 9) & Chr(9) & CenterText("Test", 9) & Chr(9) & CenterText("Test", 9)

As far as creating a new line if your string runs long, I'm not sure I understand what you are trying to do.

Any ideas? Your code is working great though but some of my blocks of strings extend 2 or 3 lines which I need to stay centered in its column. This is going to take some creativity.

 

[bradyboyy88]

I have put together some code to do what I want but its incomplete. I need to a way to keep looping through the array of strings until they all become less than the max string length. Any help would be appreciated and the code is below:

Function CenterTextImproved(arr() As String) As String
    
    'FIRST COMPONENT OF ARRAY HAS THE STRING AND SECOND COMPONENT HAS THE MAX STRING LENGTH FOR COLUMN
    Dim e As Long
    Dim L, R
    Dim CenterText As String
    
    
    For e = LBound(arr, 1) To UBound(arr, 1)
        
        If Len(arr(e, 1)) < arr1(e, 2) Then
        
            L = Int((arr1(e, 2) - Len(arr(e, 1))) / 2)
            R = arr1(e, 2) - (L + Len(arr(e, 1))) '<- correction
            CenterText = CenterText & Space(L) & arr1(e, 1) & Space(R)
            arr1(e, 1) = ""
            
        ElseIf Len(arr(e, 1)) > arr1(e, 2) Then
        
            CenterText = CenterText & Left(arr1(e, 1), arr1(e, 2))
            arr1(e, 1) = Right(arr1(e, 1), Len(arr1(e, 1)) - arr1(e, 2))
            
        Else
        
            CenterText = CenterText & arr1(e, 1)
            arr1(e, 1) = ""
            
        End If
        
        If e = UBound(arr, 1) Then
        
            CenterText = CenterText & vbNewLine
            
        End If
    
    Next e
    
    CenterTextImproved = CenterText
    
End Function