Added New Lines To My Code, Now My Listbox Isn't populating ...

[Ark68]

With a click of a commandbutton on my worksheet ...

Sub CB1_Click()

' "SELECT" button from Select_date_file userform
' Commences the analysis of selected file

Dim wsdynamic As Worksheet
Dim wb_source As String
Dim wb_source2 As Workbook
Dim ws_source As Worksheet
Dim r_cnt As Integer
Dim src_path As String
Dim src_fn As String
Dim dr As Long
Dim mcdv As Long
Dim in1 As String

    Set wsdynamic = Workbooks("Sports15b").Worksheets("DYNAMIC")
    'delete named ranges
    Worksheets("TEMP_HOLD").Columns(1).Clear
    For Each nName In Names
        nName.Delete
    Next nName
    'Check to see if schedule.csv is open, close it if it is
    If IsFileOpen("H:\PWS\Parks\Parks Operations\Sports\Sports15\CLASS_DUMP\schedule.csv") Then
        in1 = MsgBox("This file is already open. It must be" & Chr(13) & "closed before proceeding." & Chr(13) & "Close schedule.csv file?", vbYesNo, "OPEN FILE")
        If in1 = vbNo Then
            Exit Sub
        Else
            Workbooks("schedule.csv").Close savechanges:=False
            Exit Sub
        End If
    End If
    'determine when current schedule was created

    'open schedule
    src_path = "H:\PWS\Parks\Parks Operations\Sports\Sports15\CLASS_DUMP\schedule.csv"
    Application.ScreenUpdating = False
    Workbooks.Open filename:=src_path
    Call GetUniques 'compile a list of available dates from within CLASS report for user selection
    UserForm1.Show
    'Application.ScreenUpdating = True
End Sub

A routine called GetUniques is run to compile a list of unique values to be used as source for a userform listbox.

Sub GetUniques()

Application.ScreenUpdating = False
Dim d As Object, c As Variant, i As Long, lr As Long
Dim temp_ws As Worksheet
Dim wb1 As Workbook
Dim v1 As Long
Dim msg1 As String
Dim rng1 As Range
Dim oFS As Object
Dim strFilename As String
Dim ui2 As Variant

Set d = CreateObject("Scripting.Dictionary")
lr = Cells(Rows.Count, 1).End(xlUp).Row
    c = Range("M1:M" & lr)
For i = 1 To UBound(c, 1)
d(c(i, 1)) = 1
Next i

Set wb1 = Workbooks("schedule.csv")
Set temp_ws = wb1.Worksheets.Add
temp_ws.Name = "temp_ws"
strFilename = "H:\PWS\Parks\Parks Operations\Sports\Sports15\CLASS_DUMP\schedule.csv"
Set oFS = CreateObject("Scripting.FileSystemObject")

With temp_ws
    .Range("A1") = "CLASS DATE"
    .Range("B1") = "DATE SELECTION"
    .Range("C1") = "RECORDS"
    .Range("D1") = "FILE DATE"
    .Range("E1") = "SERIAL DATE"
    .Range("A2").Resize(d.Count) = Application.Transpose(d.keys)
    v1 = WorksheetFunction.Count(.Range("A:A"))
    'MsgBox "This report created on " & oFS.GetFile(strFilename).Datelastmodified & Chr(13) & "contains data for " & v1 & " dates:"
    For i = 1 To v1
        .Range("B" & i + 1) = Format(.Range("A" & i + 1), "ddd dd-mmm")
        .Range("C" & i + 1) = WorksheetFunction.CountIf(Worksheets("schedule").Range("M:M"), .Range("A" & i + 1))
        .Range("D" & i + 1) = Format(.Range("A" & i + 1), "dd-mmm")
        .Range("E" & i + 1) = .Range("A" & i + 1)
    Next i
    For Each rng1 In Range("A2:A" & v1 + 1)
        msg1 = msg1 & vbLf & Cells(rng1.Row, 1) & " (" & rng1.Offset(0, 2) & " records" & ")"
    Next rng1
    ui2 = MsgBox("This report created on " & Chr(13) & Chr(13) & oFS.GetFile(strFilename).Datelastmodified & Chr(13) & Chr(13) & "contains data for " & v1 & " dates:" & vbLf & msg1 & Chr(13) & Chr(13) & "Press YES to proceed with this schedule, or " & Chr(13) & "select NO to create a new schedule.", vbQuestion + vbYesNoCancel, "SCHEDULE CONTENTS")
    If ui2 = vbCancel Then
        Workbooks("schedule.csv").Close savechanges:=False
        Application.EnableEvents = True
        Exit Sub
    ElseIf ui2 = vbNo Then
        'call event
        MsgBox "CALL CREATE CLASS SCHEDULE"
        Application.EnableEvents = True
        Exit Sub
    End If
End With

'Create name for range of data to be used as list data for userform1.listbox1
Workbooks("Sports15b.xlsm").Names.Add Name:="data_file_list", RefersTo:="=OFFSET('[" & wb1.Name & "]" & temp_ws.Name & "'!$B$1,1,0,count('[" & wb1.Name & "]" & temp_ws.Name & "'!$A:$A),2)"
Application.ScreenUpdating = True
Workbooks("Sports15b.xlsm").Activate
End Sub

Before I put in the code in blue, userform1 would be displayed then after the GetUniques routine finished and listbox1 populated with a list of data (named range data_file_list).
Now with the added code, the userform displays, but the listbox isn't populated.

Private Sub UserForm1_Initialize()
    With Me.ListBox1
        .Clear
        .ColumnCount = 2
        .List = Range("data_file_list").Value
        .ListStyle = fmListStyleOption
        .MultiSelect = fmMultiSelectMulti
    End With
    With Me.TextBox1
        .Value = 0
        .Locked = True
    End With
End Sub

I'm not sure what the issue is. The list source data workbook is open, and the temporary range of data referenced by the name is in order, and the name is in the name manager ... but it's not displaying.

Thoughts? Help?

 

[Ark68]

Rewrote my GetUniques Routine,

Sub GetUniques()

Application.ScreenUpdating = False
Dim d As Object, c As Variant, i As Long, lr As Long
Dim temp_ws As Worksheet
Dim wb1 As Workbook
Dim v1 As Long
Dim strFilename As String
Dim msg1 As String
Dim rng1 As Range
Dim oFS As Object
Dim ui2 As String

Set d = CreateObject("Scripting.Dictionary")
lr = Cells(Rows.Count, 1).End(xlUp).Row
    c = Range("M1:M" & lr)
For i = 1 To UBound(c, 1)
d(c(i, 1)) = 1
Next i

Set wb1 = Workbooks("schedule.csv")
Set temp_ws = wb1.Worksheets.Add
temp_ws.Name = "temp_ws"
strFilename = "H:\PWS\Parks\Parks Operations\Sports\Sports15\CLASS_DUMP\schedule.csv"
Set oFS = CreateObject("Scripting.FileSystemObject")

With temp_ws
    
    'create headers
    .Range("A1") = "CLASS DATE"
    .Range("B1") = "DATE SELECTION"
    .Range("C1") = "RECORDS"
    .Range("D1") = "FILE DATE"
    .Range("E1") = "SERIAL DATE"
    .Range("A2").Resize(d.Count) = Application.Transpose(d.keys)
    
    'populate columns
    v1 = WorksheetFunction.Count(.Range("A:A"))
    For i = 1 To v1
        .Range("B" & i + 1) = Format(.Range("A" & i + 1), "ddd dd-mmm")
        .Range("C" & i + 1) = WorksheetFunction.CountIf(Worksheets("schedule").Range("M:M"), .Range("A" & i + 1))
        .Range("D" & i + 1) = Format(.Range("A" & i + 1), "dd-mmm")
        .Range("E" & i + 1) = .Range("A" & i + 1)
    Next i
    
    'create string list
    For Each rng1 In Range("A2:A" & v1 + 1)
        msg1 = msg1 & vbLf & Cells(rng1.Row, 1) & " (" & rng1.Offset(0, 2) & " records" & ")"
    Next rng1
    Workbooks("Sports15b.xlsm").Names.Add Name:="data_file_list", RefersTo:="=OFFSET('[" & wb1.Name & "]" & temp_ws.Name & "'!$B$1,1,0,count('[" & wb1.Name & "]" & temp_ws.Name & "'!$A:$A),2)"
    'create message box
    ui2 = MsgBox("This report created on " & Chr(13) & Chr(13) & oFS.GetFile(strFilename).Datelastmodified & Chr(13) & Chr(13) & _
        "contains data for " & v1 & " dates:" & vbLf & msg1 & Chr(13) & Chr(13) & "Press YES to proceed with this schedule, or " & Chr(13) & _
        "select NO to create a new schedule.", vbQuestion + vbYesNoCancel, "SCHEDULE CONTENTS")
    
    If ui2 = vbYes Then
        'Workbooks("Sports15b.xlsm").Names.Add Name:="data_file_list", RefersTo:="=OFFSET('[" & wb1.Name & "]" & temp_ws.Name & "'!$B$1,1,0,count('[" & wb1.Name & "]" & temp_ws.Name & "'!$A:$A),2)"
        Workbooks("Sports15b.xlsm").Activate
        Application.EnableEvents = True
        UserForm1.Show
    ElseIf ui2 = vbNo Then 'create new schedule
        'call event
        MsgBox "CALL CREATE CLASS SCHEDULE"
        Application.EnableEvents = True
        Exit Sub
    Else 'cancel - abandon task
        Workbooks("schedule.csv").Close savechanges:=False
        Application.EnableEvents = True
        Exit Sub
    End If

End With

Application.ScreenUpdating = True

End Sub

Still unable to populate my userform listbox with the values defined by named range 'data_file_list'.