VbTab alignment issue

Question

I have a listbox in VBA Excel application, where it reads three different columns and lists their contents on a single line. But the width of each item in a column varies. Thus, when I display it in the list box using "vbtab" it is not aligning the next item properly. For example, when the first item has 4 characters, it pulls the second closer, whereas if the first item has 8 characters, it pushes the second item a little too far. Any idea how to fix this?

Below is the code I am using.

Private Sub UserForm_Activate()
With ThisWorkbook.Sheets("Sheet1").Range("a1:a50")
MySearch = Array("Tba")
For i = LBound(MySearch) To UBound(MySearch)
Set rng = .Find(what:=MySearch(i), _
After:=.Cells(.Cells.Count), _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)

firstaddress = rng.Address


Do
j = 1
drovedate = rng.Offset(0, j)
j= j + 1
drivenby = rng.Offset(0, j)
j = j + 6
reason = rng.Offset(0, j)
x = x + 1
Dim LineOfText As String

CPHlsttheeba.AddItem (x & "   " & drovedate & vbTab() & vbTab & drivenby & vbTab & vbTab & reason)


Set rng = .FindNext(rng)
Loop While Not rng Is Nothing And rng.Address <> firstaddress
Next i
End With
End Sub

Answer 1

I had a similar situation creating a table in a MsgBox. I started with:

Item 1, tab, Item 2, tab, item 3.

But sometimes Item 1 or Item 2 was too long, requiring 2 tabs to keep things lined up. Some simple testing in the Immediate Window showed me that the default vbTab is 8 characters wide. So here is what I did inside a loop, then the MsgBox displayed this after the loop:

strMsg = strMsg & ary(1, m) & vbTab & IIf(Len(ary(1, m)) < 8, vbTab, "") & IIf(Len(ary(1, m)) < 16, vbTab, "") & ary(2, m) & vbTab & IIf(Len(ary(2, m)) < 8, vbTab, "") & ary(3, m) & vbCr

This essentially puts 2 or 3 tabs between results if the length of the previous result is small.

Answer 2

Siddharth's approach is better I think, but since you asked...

Instead of this:

CPHlsttheeba.AddItem  x & "   " & drovedate & vbTab() & vbTab & _
                      drivenby & vbTab & vbTab & reason

you can do this:

CPHlsttheeba.AddItem RPad(x & "   " & drovedate, 20) & _
                     RPad(drivenby, 20) & reason




'pad a string "s" on the right with spaces to total length "num"
Function RPad(s, num)
    RPad = Left(s & String(num," "), num)
End Function

You may need to adjust the amount of padding depending on how long your strings are. If you format your listbox using a fixed-with font then your "columns" should line up.

Answer 3

If your text width is known then you can use the .ColumnWidths of the ListBox1 to predefine the column width. This will ensure that the data is aligned properly. If the text width is not known then you can set the .ColumnWidths to something which you feel will accommodate all words. In the below example I have set it to 50

The other trick is not to add the data in a loop to the ListBox1 but to store it in an array and then set the .List property of the ListBox1 to that array. This will ensure that the execution of the code is faster.

Here is an example. I am manually filling the array here. You can fill the array in your Do While Loop

CODE:

Private Sub UserForm_Activate()
    Dim Myarray(1 To 2, 1 To 4) As String

    Myarray(1, 1) = "Sid"
    Myarray(1, 2) = "Apple"
    Myarray(1, 3) = "Banana"
    Myarray(1, 4) = "Mumbai"
    Myarray(2, 1) = "New Delhi"
    Myarray(2, 2) = "New York"
    Myarray(2, 3) = "Japan"
    Myarray(2, 4) = "asdfghjkl"

    With Me.ListBox1
        .Clear
        .ColumnHeads = False
        .ColumnCount = 4

        .List = Myarray

        '~~> Change 50 to 8 in your application
        .ColumnWidths = "50;50;50;50"
        .TopIndex = 0
    End With
End Sub

SCREENSHOT:

FOLLOWUP

Sorry, i am not sure how to fit my codings to work with an array and to list them.. Would you be able to help me out a bit.. – user1697952 1 hour ago

Try this (Untested)

Private Sub UserForm_Activate()
    Dim n As Long

    With CPHlsttheeba
        .ColumnHeads = False
        .ColumnCount = 4
        .ColumnWidths = "8;8;8;8"
    End With

    With ThisWorkbook.Sheets("Sheet1").Range("a1:a50")
        MySearch = Array("Tba")
        For i = LBound(MySearch) To UBound(MySearch)
            Set rng = .Find(what:=MySearch(i), _
            After:=.Cells(.Cells.Count), _
            LookIn:=xlFormulas, _
            LookAt:=xlPart, _
            SearchOrder:=xlByRows, _
            SearchDirection:=xlNext, _
            MatchCase:=False)

            firstaddress = rng.Address

            Do
                j = 1
                drovedate = rng.Offset(0, j)
                j = j + 1
                drivenby = rng.Offset(0, j)
                j = j + 6
                reason = rng.Offset(0, j)
                x = x + 1
                Dim LineOfText As String

                CPHlsttheeba.AddItem "Test" & n, n
                CPHlsttheeba .List(n, 0) = drovedate
                CPHlsttheeba .List(n, 1) = drivenby
                CPHlsttheeba .List(n, 2) = reason

                n = n + 1

                Set rng = .FindNext(rng)
            Loop While Not rng Is Nothing And _
            rng.Address <> firstaddress
        Next i
    End With
End Sub