Listbox date problem

[sharky12345]

I'm using this to load a Listbox on a Userform with values where column H has 'Overdue' but the date is coming up in the US format, whereas I need it to be in UK format;

With Me.ListBox1
.ColumnCount = 5
.ColumnWidths = "120,0,60,0,60"
End With
Set Rng = Range("D7:H57")
ReDim Ray(1 To 5, 1 To Rng.Count)
For Each Dn In Rng
If Dn.Value = "Overdue" Then
c = c + 1
For Ac = 1 To 5
Ray(Ac, c) = Dn.Offset(, -(5 - Ac))
Next Ac
End If
Next Dn
ReDim Preserve Ray(1 To 5, 1 To c)
Me.ListBox1.List = Application.Transpose(Ray)

I've had this issue previously and had a solution provided but that was for a Listbox without criteria and can't work out how to amend it;

With Me.ListBox1
.ColumnCount = 12
.ColumnWidths = "70,70,70,100,100,100,100,100,100,100,100,100"
.RowSource = Range(Range("A3"), Range("L" & Rows.Count).End(xlUp)).Address
End With

Is anyone able to show me how I can achieve this please?

 

[dmt32]

Hi,
You asked same / similar question here in 2015:https://www.mrexcel.com/forum/excel-questions/882387-listbox-date-formate-problem.html

did try the suggestion I offered to you post #4 ?


Dave

 

[sharky12345]

Hi Dave,

Yes I did, and it works in that scenario but as with the one above, I don't know how to incorporate a criteria into it.

 

[dmt32]

Hi Dave,

Yes I did, and it works in that scenario but as with the one above, I don't know how to incorporate a criteria into it.

Hi,
you should be able to add another argument to function to filter required records only.

I don't have much time at moment but see if this untested update to the function works for you

Function StringArray(ByVal Target As Range, Optional Criteria As Variant) As String()
    Dim RangeArray() As String
    Dim c As Range
    Dim CriteriaCount As Long
    Dim i As Long, a As Long
    
    If Not IsMissing(Criteria) Then
        CriteriaCount = Application.CountIf(Target, Criteria)
    Else
        CriteriaCount = Target.Rows.Count
    End If
    
    ReDim RangeArray(1 To CriteriaCount, 1 To Target.Columns.Count) As String
    
    For Each c In Target
        If Not IsMissing(Criteria) Then
            m = Application.Match(Criteria, Target.Rows(c.Row), False)
            If Not IsError(m) Then
                If a <> c.Row Then a = c.Row: i = i + 1
                RangeArray(i, c.Column) = c.Text
            End If
        Else
            RangeArray(c.Row - Target.Row + 1, c.Column) = c.Text
        End If
    Next c
    StringArray = RangeArray
End Function

to call it:

Set rng = Range(Range("D7"), Range("H" & Rows.Count).End(xlUp))
   Me.ListBox1.List = StringArray(rng, "Overdue")

I made Criteria argument Optional, if you omit it all records should be returned.
update not very elegant and maybe someone can offer a cleaner solution.

Hope Helpful

Dave

 

[sharky12345]

Hi Dave - thanks for your efforts, much appreciated.....

It fails though giving me an error 9 on the following line;

ReDim RangeArray(1 To CriteriaCount, 1 To Target.Columns.Count) As String

Don't worry about spending more time on this though, I will keep playing around to see how far I can get.

Thanks!!

 

[Norie]

Which column has the dates?

 

[sharky12345]

Hello Norie - it's column F.

 

[Norie]

Try this.

With Me.ListBox1
    .ColumnCount = 5
    .ColumnWidths = "120,0,60,0,60"
End With

Set Rng = Range("D7:H57")

ReDim Ray(1 To 5, 1 To Rng.Count)

For Each Dn In Rng
    If Dn.Value = "Overdue" Then
        c = c + 1
        For Ac = 1 To 5
            Ray(Ac, c) = Dn.Offset(, -(5 - Ac)).Text
        Next Ac
    End If
Next Dn

Me.ListBox1.Column =Ray

 

[sharky12345]

Perfect!

Thanks to both of you for your efforts guys!