PDA

View Full Version : Listbox Not Populating - Source is dynamic named range



JennyEx
10-06-2015, 08:12 AM
I am experiencing a crippling hurdle to my application that I am struggling to find help overcoming.

I have a userform (userform1) with a listbox (listbox1) that is populated by a dynamic set of values in column A of worksheet 'temp_hold'. This dynamic range is given a name, and it is this named range that is referenced in the userform initialization code to populate listbox1.

I have had it working, but after I added some error checking code, and did some minor restructuring, I can no longer get my listbox to populate. :-( Without this ability, my application has come to a screeching halt. Be advised, this issue has been cross posted [unable to post links yet] where it appears I may have stumped folks there. I'm hoping I can tap into the knowledge of new fresh group of skilled individuals.

Here is my code:

A click of a command button in my worksheet launches code which prepares the destination worksheet, and opens the source workbook (closing it first if it's already open at this stage).


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 ws_data 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
Dim ui2 As Variant
Dim strFilename As String
Dim rng1 As Range


Set wsdynamic = Workbooks("Sports15b").Worksheets("DYNAMIC")

'prepare destination worksheet
Worksheets("TEMP_HOLD").Columns(1).Clear

'clear named ranges
'For Each nName In Names
' nName.Delete
'Next nName

'close any open instance of schedule.csv
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


'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
Application.ScreenUpdating = True
End Sub

A subroutine called 'GetUniques' is called. It creates a list of unique dates from column M in the source workbook (schedule.csv) and places them in the destination worksheet (workbook:sports15b.xlsm, worksheet:temp_hold). It is this created list that is used to creat the named range that is used as the source in my 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 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
Workbooks("schedule.csv").Close savechanges:=False
Application.EnableEvents = True
Exit Sub
End If


End With


Application.ScreenUpdating = True


End Sub

The code in blue is the code used to create the named range.

Once the user confirms to proceed (vbyes) then the userform is opened which hosts the listbox.


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

At this point, the listbox is empty.

I will be most grateful to all those that are able to contribute any advice. I'm just learning VBA, so am at a loss.

mperrah
10-06-2015, 04:14 PM
Not sure where the problem is, but I would consider using a variable for workbook and worksheet for source and destination.
when you have 2 workbooks open there can be an issue when pulling a range source that is not explicitly named.

Set wsdynamic = Workbooks("Sports15b").Worksheets("DYNAMIC")

Set wb1 = Workbooks("schedule.csv")

These are good

In the userform be sure to use these in front of range
Like:

Private Sub UserForm1_Initialize()
With Me.ListBox1
.Clear
.ColumnCount = 2
.List = wsdynamic.Range("data_file_list").Value

and I'm not understanding why you have .name after the workbook reference in your blue section (I removed them)

Workbooks("Sports15b.xlsm").Names.Add Name:="data_file_list", RefersTo:="=OFFSET('[" & wb1 & "]" & temp_ws & "'!$B$1,1,0,count('[" & wb1 & "]" & temp_ws & "'!$A:$A),2)"

What was the last change you did before this stopped working?

snb
10-07-2015, 02:49 AM
You can skip all the fuss using


Private sub userform_initialize()
with getobject("H:\PWS\Parks\Parks Operations\Sports\Sports15\CLASS_DUMP\schedule.csv")
sn=.sheets(1).columns(13).specialcells(2)
.close 0
end with

with CreateObject("Scripting.Dictionary")
for j=1 to ubound(sn)
x0=.item(sn(j,1))
next

listbox1.list=.keys
end with
End Sub

NB.
- Named ranges are a tool for those that use the UI instead of VBA. In VBA they have no use.
- the properties of a listbox should be set in design mode, not in runtime.

@Perrah

To 'clear' a listbox is redundant if you use the method .List=

JennyEx
10-07-2015, 03:49 AM
Thank you both for some very valuable information. Your two posts have provided me with some additional learning and that is as beneficial as having the problem solved.
Perrah, I was intrigued by your advice and comments. I personally don't like using named ranges (I find them confusing) and this one in particular bogged me down for quite a while. Little did I know there was a much more direct approach. Cool.

Needless to say, I spent more time compiling my original post, that after some tested discovered what I think was the problem. A very basic, simple problem in the userform initialization code,


Private Sub UserForm1_Initialize() ...

seems to work when it's changed to ...


Private Sub UserForm_Initialize().

Perhaps this was the problem all along.

mperrah
10-08-2015, 11:34 AM
way to sleuth :)