populate a range ("a3:h40") into listbox if cell in column "H" is interior.colorindex = 3.

[BRB1983]

i want to populate information from range("A3:H40") to listbox only if Cell in Column("H") is colored red. the provided code list them all, even when a cell in column h is not red.

Dim lbtarget As MSForms.ListBox
Dim rngSource As Range
Set rngSource = Sheet1.Range("A3:H19")
Dim RNG As Range
Set RNG = Sheet1.Range("H3:H19")
Dim Cell As Range

Set lbtarget = Me.ListBox1
    With lbtarget
        .ColumnCount = 8
        .ColumnWidths = "100;100;100;100;100;100;60;60"
    For Each Cell In RNG
        If Cell.Interior.ColorIndex = 3 Then
      
        .List = rngSource.Cells.value
        End If
        Next
    End With

 

[DanteAmor]

If you are going to load only the rows where the cell in column H is red, then try the following:

Private Sub UserForm_Activate()
  Dim RngSource As Range, Cell As Range
  Set RngSource = Sheet1.Range("A3:H19")
 
  With ListBox1
    .ColumnCount = 8
    .ColumnWidths = "100;100;100;100;100;100;60;60"
    For Each Cell In RngSource.Columns(8).Rows
      If Cell.Interior.ColorIndex = 3 Then
        .AddItem
        .List(.ListCount - 1, 0) = RngSource.Cells(Cell.Row - 2, "A")
        .List(.ListCount - 1, 1) = RngSource.Cells(Cell.Row - 2, "B")
        .List(.ListCount - 1, 2) = RngSource.Cells(Cell.Row - 2, "C")
        .List(.ListCount - 1, 3) = RngSource.Cells(Cell.Row - 2, "D")
        .List(.ListCount - 1, 4) = RngSource.Cells(Cell.Row - 2, "E")
        .List(.ListCount - 1, 5) = RngSource.Cells(Cell.Row - 2, "F")
        .List(.ListCount - 1, 6) = RngSource.Cells(Cell.Row - 2, "G")
        .List(.ListCount - 1, 7) = RngSource.Cells(Cell.Row - 2, "H")
      End If
    Next
  End With
End Sub

Or this:

Private Sub UserForm_Activate()
  Dim RngSource As Range, Cell As Range
  Set RngSource = Sheet1.Range("A3:H19")
 
  With ListBox1
    .ColumnCount = 8
    .ColumnWidths = "100;100;100;100;100;100;60;60"
    For Each Cell In RngSource.Columns(8).Rows
      If Cell.Interior.ColorIndex = 3 Then
        .AddItem
        .List(.ListCount - 1, 0) = Cell.Offset(, -7)
        .List(.ListCount - 1, 1) = Cell.Offset(, -6)
        .List(.ListCount - 1, 2) = Cell.Offset(, -5)
        .List(.ListCount - 1, 3) = Cell.Offset(, -4)
        .List(.ListCount - 1, 4) = Cell.Offset(, -3)
        .List(.ListCount - 1, 5) = Cell.Offset(, -2)
        .List(.ListCount - 1, 6) = Cell.Offset(, -1)
        .List(.ListCount - 1, 7) = Cell
      End If
    Next
  End With
End Sub

Or this

Private Sub UserForm_Activate()
  Dim RngSource As Range, Cell As Range, j As Long
  Set RngSource = Sheet1.Range("A3:H19")
 
  With ListBox1
    .ColumnCount = 8
    .ColumnWidths = "100;100;100;100;100;100;60;60"
    For Each Cell In RngSource.Columns(8).Rows
      If Cell.Interior.ColorIndex = 3 Then
        .AddItem
        For j = 0 To 7
          .List(.ListCount - 1, j) = RngSource.Cells(Cell.Row - 2, j + 1)
        Next
      End If
    Next
  End With
End Sub

 

[DanteAmor]

How about:

Private Sub UserForm_Activate()
  Dim RngSource As Range, Cell As Range, j As Long
  Dim arrResults, n As Long
  Set RngSource = Sheet1.Range("A3:H19")
 
  ReDim arrResults(1 To RngSource.Rows.Count, 1 To 8)
  With ListBox1
    .ColumnCount = 8
    .ColumnWidths = "100;100;100;100;100;100;60;60"
    n = 1
    For Each Cell In RngSource.Columns(8).Rows
      If Cell.Interior.ColorIndex = 3 Then
        arrResults(n, 1) = Cell.Offset(, -7)
        arrResults(n, 2) = Cell.Offset(, -6)
        arrResults(n, 3) = Cell.Offset(, -5)
        arrResults(n, 4) = Cell.Offset(, -4)
        arrResults(n, 5) = Cell.Offset(, -3)
        arrResults(n, 6) = Cell.Offset(, -2)
        arrResults(n, 7) = Cell.Offset(, -1)
        arrResults(n, 8) = Cell
        n = n + 1
      End If
    Next
    .List = arrResults
  End With
End Sub

 

[BRB1983]

Post # 2 works great thanks a bunch.

 

[DanteAmor]

I'm glad to help you. Thanks for the feedback.