list box fill with each item color

[Waqas ali]

I have items in list box. I want to display with each item with its own color

 

[pbornemeier]

As far as I know this cannot be done in a standard listbox, but this post:
Change the color of text in a listbox based upon a certain criteria
explains how to do it with the 'Microsoft Listview Control 6.0' which is available in Excel 2010 (probably other Excel versions as well).

 

[pbornemeier]

Option Explicit

Private Sub UserForm_Initialize()
    'Copied from http://www.vbaexpress.com/forum/showthread.php?9152-Change-the-color-of-text-in-a-listbox-based-upon-a-certain-criteria
    ' because links sometimes get broken
    
    'Using 'Microsoft Listview Control 6.0'
    '  more at https://msdn.microsoft.com/en-us/library/ms172636(v=vs.90).aspx
    '  but that info seems to be for a later version
    
    'Fill A2:Dxx with numbers, if col B number is <1 then the column A number in
    '  the listview box will be red
    
    Dim startrow As Integer     'beginning of data
    Dim endrow As Integer       'end of data
    Dim pos As Integer          'actual row
    Dim lv_item As Integer      'no of the listview item
    Dim counting As Integer     'loop for processing all items
    Dim sSheetName As String    'Sheet that contains the ListView control
    
    sSheetName = "Sheet3"
    
    startrow = 2
    endrow = Worksheets(sSheetName).Range("B" & Rows.Count).End(xlUp).Row

    pos = 2
    lv_item = 1
    With ListView1
         'gives me headers at the top
        .View = lvwReport
         'defining the columnheaders
        With .ColumnHeaders
            .Clear
            .Add , , "Column 1", 60
            .Add , , "Column 2", 60
            .Add , , "Column 3", 60
            .Add , , "Column 4", 60
        End With
        .HideColumnHeaders = False
        .Appearance = cc3D
        .FullRowSelect = True
        For counting = startrow To endrow
            If Worksheets(sSheetName).Range("B" & pos).Value > 1 Then
                .ListItems.Add , , Worksheets(sSheetName).Range("A" & pos)
                .ListItems(lv_item).ForeColor = RGB(255, 0, 0)
                .ListItems(lv_item).ListSubItems.Add , , Worksheets(sSheetName).Range("B" & pos)
                .ListItems(lv_item).ListSubItems.Add , , Worksheets(sSheetName).Range("C" & pos)
                .ListItems(lv_item).ListSubItems.Add , , Worksheets(sSheetName).Range("D" & pos)
                .ListItems(lv_item).Bold = True
            Else
                .ListItems.Add , , Worksheets(sSheetName).Range("A" & pos)
                .ListItems(lv_item).ForeColor = RGB(0, 0, 0)
                .ListItems(lv_item).ListSubItems.Add , , Worksheets(sSheetName).Range("B" & pos)
                .ListItems(lv_item).ListSubItems.Add , , Worksheets(sSheetName).Range("C" & pos)
                .ListItems(lv_item).ListSubItems.Add , , Worksheets(sSheetName).Range("D" & pos)
             End If
           lv_item = lv_item + 1
            pos = pos + 1
        Next counting
    End With
End Sub