Listbox columns question if i may

[ipbr21054]

Afternoon.

On my usefrorm i search for a name by typing in TextBox8
The results from which are collected from my worksheet are then shown in ListBox1
Please see attached photo

What i would also like is for the Date to be collected from the worksheet & put alongside the name in the ListBox
So it would be like
ANDY JONES 01/05/ 2020
ATLAS BROWN 16/11/2020

ETC ETC

The date is in column A

I have the code in use supplied.

Private Sub ListBox1_Click()
  Range("B" & ListBox1.List(ListBox1.ListIndex, 1)).Select
  Unload PostageTransferSheet
End Sub
Private Sub TextBox8_Change()
  Dim r As Range, f As Range, Cell As String, added As Boolean
  Dim sh As Worksheet

  Set sh = Sheets("POSTAGE")
  sh.Select
  With ListBox1
    .Clear
    .ColumnCount = 2
    .ColumnWidths = "100;0"
    If TextBox8.Value = "" Then Exit Sub
    Set r = Range("B8", Range("B" & Rows.Count).End(xlUp))
    Set f = r.Find(TextBox8.Value, LookIn:=xlValues, LookAt:=xlPart)
    If Not f Is Nothing Then
      Cell = f.Address
      Do
        added = False
        For i = 0 To .ListCount - 1
          Select Case StrComp(.List(i), f.Value, vbTextCompare)
            Case 0, 1
              .AddItem f.Value, i
              .List(i, 1) = f.Row
              added = True
              Exit For
          End Select
        Next
           If added = False Then
          .AddItem f.Value
          .List(.ListCount - 1, 1) = f.Row
        End If
        Set f = r.FindNext(f)
      Loop While Not f Is Nothing And f.Address <> Cell
      TextBox8 = UCase(TextBox8)
      .TopIndex = 0
      Else
      MsgBox "NO CUSTOMER WAS FOUND USING THAT INFORMATION", vbCritical, "POSTAGE SHEET CUSTOMER NAME SEARCH"
      TextBox8.Value = ""
      TextBox8.SetFocus
    End If
  End With
End Sub

 

[ipbr21054]

I think you might need this also ?

Private Sub UserForm_Initialize()
  Dim cl As Range, rng As Range, lstrw As Long, LastRow As Long, Lastrowa As Long, cntr As Integer
 
  TextBox2.SetFocus
  Application.ScreenUpdating = False
  LastRow = Sheets("POSTAGE").Cells(Rows.Count, "B").End(xlUp).Row
  Sheets("POSTAGE").Cells(8, 2).Resize(LastRow - 7).Copy Sheets("POSTAGE").Cells(1, 12)
  Lastrowa = Sheets("POSTAGE").Cells(Rows.Count, "L").End(xlUp).Row
  Sheets("POSTAGE").Cells(1, 12).Resize(Lastrowa).Sort Key1:=Cells(1, 12).Resize(Lastrowa), Order1:=xlAscending, Header:=xlNo

  Sheets("POSTAGE").Cells(1, 12).Resize(Lastrowa).Clear
 
  cntr = 1
  With Sheets("POSTAGE")
    lstrw = .Range("B65536").End(xlUp).Row
    Set rng = .Range("B8:B" & lstrw)
    For Each cl In rng
      If cl.Offset(0, 5).Value = "" Then Sheets("POSTAGE").Range("L" & cntr).Value = cl.Value: cntr = cntr + 1


      If cl.Offset(0, 5).Value = "POSTED" Then Sheets("POSTAGE").Range("L" & cntr).Value = cl.Value: cntr = cntr + 1 '<--- added this line


    Next
    If cntr = 1 Then
      MsgBox "ALL PARCELS HAVE NOW BEEN DELIVERED ", vbExclamation, "POSTAGE SHEET DATE TRANSFER MESSAGE"
      Unload PostageTransferSheet
    ElseIf cntr = 2 Then
      NameForDateEntryBox.AddItem .Range("L1").Value
    Else
      .Range("L1:L" & cntr - 1).Sort Key1:=.Range("L1"), Order1:=xlAscending, Header:=xlNo
      NameForDateEntryBox.List = .Range("L1:L" & cntr - 1).Value
      NameForDateEntryBox.List = Sheets("POSTAGE").Cells(1, 12).Resize(Lastrowa).Value


      '.Range("L1:L" & cntr - 1).Clear '<----- commented out this line


      TextBox2.SetFocus
    End If
  End With
  Dim l As MSForms.ComboBox
Dim i As Long: i = 0
Set l = Me.NameForDateEntryBox


While i < l.ListCount
 If "" = l.List(i, 0) Then: l.RemoveItem (i): Else i = 1 + i
Wend

  Application.ScreenUpdating = True
  TextBox1.Value = Format(CDbl(Date), "dd/mm/yyyy")
  TextBox7.Value = Format(CDbl(Date), "dd/mm/yyyy")
End Sub