Populating listbox based on two (or more) criteria

**jasonsweeney** · 08-10-2005, 12:41 AM

Employees enter information into a user form. Once done, they press a command button that launches a macro that populates cells in a worksheet with the following information in Row "1" to Row n of Columns "A" through "E" for each individual entry:

A...............B...................C.....................D .............................................E
DATE........CLASS-NUM....PART-NAME.....DESCRIPTION OF PROBLEM.....DOWN-TIME
1 08/09/05 0934043 Widget A faulty wiring 02:40:00
2 08/09/05 0934043 Widget A cracked casing 00:05:00
Etc.

Often, in a given day, a number of entries will have the same Class-Num. At the end of the day, we want a userform to list in a list-box (?) for us, block entries that look like, for example, the following (in all-caps), in reference to a whole family of entries that share a common class-num:

"[4:31:00] WIDGET A (0934043): FAULTY WIRING (02:45:00); CRACKED CASING (00:05:00); FAULTY WIRING (00:13:50); UNKNOWN ERROR (01:11:00); SEEMS TO NOT FIT NEW HEAD ASSEMBLY (00:30:00)"

"[2:00:00] WIDGET B (0029777): SECOND SHIPMENT OF WRONG SKU (01:50:00); TRAINING OF NEW OPERATOR (00:10:00)"

Obviously, the information is listed in the order: Total down-time, name of part, class number, description, and finally individual down time as to each individual entry.

I have a simple code that populates the listbox with all entries that were made on the relevant date:
_________________
For i = 1 To 10005
If Sheet1.Cells(i, "A").Value = todays_date Then
entry.ListBox_todaymats.AddItem Sheet1.Cells(i, "B").Value & " " & Cells(i, "C").Value & " " & Cells(i, "D").Value & " " & Cells(i, "E").Value
End If
next
_________________

But I am stuck on hwo to proceed. I need Excel to:
(1) First only look at entries made on today's date (above code does this);
(2) Next look only at entries made today that have common class-num
(3) Then, group all common class-nums together and display infor as shown above;
(4) Then, repeat step 3 for other class-nums entered today;
(5) and finally, open a word document and paste all the data into a word document in the same manner as referenced above.

Patrick Molloy · 08-10-2005, 09:05 AM

A pivot table would do the bulk of what you need.

"jasonsweeney" wrote:

>
> Employees enter information into a user form. Once done, they press a
> command button that launches a macro that populates cells in a
> worksheet with the following information in Row "1" to Row n of Columns
> "A" through "E" for each individual entry:
>
> A...............B...................C.....................D
> .............................................E
> DATE........CLASS-NUM....PART-NAME.....DESCRIPTION OF
> PROBLEM.....DOWN-TIME
> 1 08/09/05 0934043 Widget A faulty wiring
> 02:40:00
> 2 08/09/05 0934043 Widget A cracked casing
> 00:05:00
> Etc.
>
> Often, in a given day, a number of entries will have the same
> Class-Num. At the end of the day, we want a userform to list in a
> list-box (?) for us, block entries that look like, for example, the
> following (in all-caps), in reference to a whole family of entries that
> share a common class-num:
>
> "[4:31:00] WIDGET A (0934043): FAULTY WIRING (02:45:00); CRACKED CASING
> (00:05:00); FAULTY WIRING (00:13:50); UNKNOWN ERROR (01:11:00); SEEMS TO
> NOT FIT NEW HEAD ASSEMBLY (00:30:00)"
>
> "[2:00:00] WIDGET B (0029777): SECOND SHIPMENT OF WRONG SKU (01:50:00);
> TRAINING OF NEW OPERATOR (00:10:00)"
>
> Obviously, the information is listed in the order: Total down-time,
> name of part, class number, description, and finally individual down
> time as to each individual entry.
>
> I have a simple code that populates the listbox with all entries that
> were made on the relevant date:
> _________________
> For i = 1 To 10005
> If Sheet1.Cells(i, "A").Value = todays_date Then
> entry.ListBox_todaymats.AddItem Sheet1.Cells(i, "B").Value & "
> " & Cells(i, "C").Value & " " & Cells(i, "D").Value & " " &
> Cells(i, "E").Value
> End If
> next
> _________________
>
> But I am stuck on hwo to proceed. I need Excel to:
> (1) First only look at entries made on today's date (above code does
> this);
> (2) Next look only at entries made today that have common class-num
> (3) Then, group all common class-nums together and display infor as
> shown above;
> (4) Then, repeat step 3 for other class-nums entered today;
> (5) and finally, open a word document and paste all the data into a
> word document in the same manner as referenced above.
>
>
> --
> jasonsweeney
> ------------------------------------------------------------------------
> jasonsweeney's Profile: http://www.excelforum.com/member.php...fo&userid=5222
> View this thread: http://www.excelforum.com/showthread...hreadid=394466
>
>

**jasonsweeney** · 08-10-2005, 10:58 AM

Needs to be VBA Code. This is part of a larger functionality.

**jasonsweeney** · 08-11-2005, 12:33 AM

So I have tried several different ideas on the above to no avail.

One thing that would help would be a way to count the the number of items that have certain qualities....in excel function code:

=if(and(A=[todays date], B=[Class Num n], C=[Part Description]), [Add to this block entry], [don't add to this block entry])

anyhow....Please advise.

-- Jason

Patrick Molloy · 08-12-2005, 06:05 PM

ok
what you could do is use a Dictionary - actually its really a collection -
but it has several advanyages in that you can loop through both the items
and the keys, and also, and most importantly, it has an Exists method that
you can use to test if a key exists or not.

What you do is list through your table, creatitng the text string as
required depending on whether the class-num (rour key) is there or not....

so, in the VBA IDE under Tools/References set a reference to Microsoft
Scripting Runtime ... this is the library containg, among other things, the
dictionary.

Try this code in a standard module. It assumes that the data table is NOT
range named, but the sheet is SHEET1 and that the data headers are in row
1,

Option Explicit
Sub test()
GatherData DateValue("9-Aug-2005")
End Sub

Sub GatherData(targetdate As Date)

Dim dData As Scripting.Dictionary
Dim rw As Long
Dim text As String
Dim ws As Worksheet
Dim key As String
Dim index As Long

Set dData = New Scripting.Dictionary
Set ws = Worksheets("SHEET1")
rw = 2 ' skip the first row

With ws
Do Until Cells(rw, 1) = ""
If CDate(.Cells(rw, 1)) = targetdate Then
key = .Cells(rw, 3)

If dData.Exists(key) Then
text = dData.Item(key)
text = text & ";" & .Cells(rw, 4).Value
text = text & "(" & Format(.Cells(rw, 5).Value, "HH:MM")
& ")"
Else
For index = 1 To 4
text = text & ";" & .Cells(rw, index).Value
Next
text = text & "(" & Format(.Cells(rw, 5).Value, "HH:MM")
& ")"
text = Mid(text, 2)
dData.Add key, text
End If

End If

rw = rw + 1
Loop

' row is the last row of data
' so for this demo, I'll drop the results below
'the table
rw = rw + 2

For index = 1 To dData.Count
.Cells(rw + index, 1) = dData.Items(index - 1)

Next
End With

End Sub

"jasonsweeney" <[email protected]>
wrote in message
news:[email protected]...
>
> Employees enter information into a user form. Once done, they press a
> command button that launches a macro that populates cells in a
> worksheet with the following information in Row "1" to Row n of Columns
> "A" through "E" for each individual entry:
>
> A...............B...................C.....................D
> ............................................E
> DATE........CLASS-NUM....PART-NAME.....DESCRIPTION OF
> PROBLEM.....DOWN-TIME
> 1 08/09/05 0934043 Widget A faulty wiring
> 02:40:00
> 2 08/09/05 0934043 Widget A cracked casing
> 00:05:00
> Etc.
>
> Often, in a given day, a number of entries will have the same
> Class-Num. At the end of the day, we want a userform to list in a
> list-box (?) for us, block entries that look like, for example, the
> following (in all-caps), in reference to a whole family of entries that
> share a common class-num:
>
> "[4:31:00] WIDGET A (0934043): FAULTY WIRING (02:45:00); CRACKED CASING
> (00:05:00); FAULTY WIRING (00:13:50); UNKNOWN ERROR (01:11:00); SEEMS TO
> NOT FIT NEW HEAD ASSEMBLY (00:30:00)"
>
> "[2:00:00] WIDGET B (0029777): SECOND SHIPMENT OF WRONG SKU (01:50:00);
> TRAINING OF NEW OPERATOR (00:10:00)"
>
> Obviously, the information is listed in the order: Total down-time,
> name of part, class number, description, and finally individual down
> time as to each individual entry.
>
> I have a simple code that populates the listbox with all entries that
> were made on the relevant date:
> _________________
> For i = 1 To 10005
> If Sheet1.Cells(i, "A").Value = todays_date Then
> entry.ListBox_todaymats.AddItem Sheet1.Cells(i, "B").Value & "
> " & Cells(i, "C").Value & " " & Cells(i, "D").Value & " " &
> Cells(i, "E").Value
> End If
> next
> _________________
>
> But I am stuck on hwo to proceed. I need Excel to:
> (1) First only look at entries made on today's date (above code does
> this);
> (2) Next look only at entries made today that have common class-num
> (3) Then, group all common class-nums together and display infor as
> shown above;
> (4) Then, repeat step 3 for other class-nums entered today;
> (5) and finally, open a word document and paste all the data into a
> word document in the same manner as referenced above.
>
>
> --
> jasonsweeney
> ------------------------------------------------------------------------
> jasonsweeney's Profile:
> http://www.excelforum.com/member.php...fo&userid=5222
> View this thread: http://www.excelforum.com/showthread...hreadid=394466
>

**jasonsweeney** · 08-14-2005, 02:13 PM

Patrick,

When I try your code, the code:

Dim dData As Scripting.Dictionary

creates an "user defined type not defined" error

**jasonsweeney** · 08-22-2005, 10:42 PM

I am still having trouble (conceptually) with using the dictionary as outlined above.

A couple of questions:

(1) Is it possible to add item in the dictionary? E.G.

d.add "A", 10
d.add "A", 16
d.add "B", 2
d.add "C", 3

Can I now somehow calculate the sum of items that belong to key "A"?

(2) In my specific application, I need the the looping procedure to:
(A) look at column B for today's date (there are thousands of entries in Column B, from many different dates). I guess the date needs to be the key.
(B) look next at column C for "Class Numbers". Problem is, I need this to also be a key....I need to collect all the individual entries that share a common class number, and apend them to one another in the format: text = Description_of_Problem & " (" & Down_Time & "); "....[repeat for (n) items that share common "Class Numbers".
(C) I then need the loop to look at the next Class Number and repeat step "B"....this for as many different Class_Numbers that were entered that day (often in practice as many as 35, but usually = 15 different class_nums per day, with as many as 20 or more individual entries per class_num)
(D) Then, finally I need to display these entries as separate "blocks" of text. For example, if there were 11 different class_nums entered on Monday, I need 11 different entries at the end of the day. In this format:

"[4:31:00] WIDGET A (0934043): FAULTY WIRING (02:45:00); CRACKED CASING
(00:05:00); FAULTY WIRING (00:13:50); UNKNOWN ERROR (01:11:00); SEEMS TO
NOT FIT NEW HEAD ASSEMBLY (00:30:00)"

The first number above (i.e. "4:31:00") needs to be the sum of the indivdual time entries for that class_num for that day. The next text "Widget A (0934043)" represents the name of the component part, and the number in the paranthetical is the Class_Num. NOW, the "text" item I described above in comment B needs to be added to the other text before...i.e. the "FAULTY WIRING (02:45:00); CRACKED CASING (00:05:00); FAULTY WIRING (00:13:50); UNKNOWN ERROR (01:11:00); SEEMS TO NOT FIT NEW HEAD ASSEMBLY (00:30:00)"

Any ideas would be appreciated....

**jasonsweeney** · 02-04-2006, 07:44 PM

Thanks to Partick's help, I was able to get to my solution. The code is below:

You need:
-- Userform1
-- Textbox named "TextBox_currentdate"
-- ListBox1
-- CommandButton1 (which calls sub routine "gather")
-- Data on Sheet1
-- Column Titles are located in Sheet1.Range("A1:F1"):
-- A1: [=counta(a1:a10001)]
-- B1: "Date"
-- C1: "SKU Number"
-- D1: "Item Nickname"
-- E1: "Description"
-- F1: "Time"
-- Enter data below each column header, to see how it works enter 3 items for today's date with SKU Number "001" and 3 items for Today's date with SKU Number "002". Time is entered in tenths of an hour, i.e. "1.5" = 1 and 1/2 hour.
-- Code below will drop the output into Sheet2
-- In my actual userform I have some buttons that allow the user to cycle through various dates, e.g. changing the value of TextBox_currentdate +/- 1 day at a time. The sub routine "gather" is called each time the date changes, thus updating the listbox with that day's items....
______________
Sub gather()

Dim date_day As String
Dim date_month As String
Dim date_year As String
Dim the_date As String
'
date_day = Day(UserForm1.TextBox_currentdate.Value)
date_month = Month(UserForm1.TextBox_currentdate.Value)
date_year = Year(Userform1.TextBox_currentdate.Value)
the_date = DateSerial(date_year, date_month, date_day)
gatherdata (the_date)
End Sub

Sub gatherdata ()
Dim dData As Scripting.Dictionary
Dim rw As Long
Dim text As String
Dim ws As Worksheet
Dim key As String
Dim index As Long
Set dData = New Scripting.Dictionary
Sheet2.Range("a1:a10001").Clear
UserForm1.ListBox1.Clear
'
Set ws = Sheet1
rw = 6 ' skip the first five rows

With ws
ten_plus = 0
Do Until Cells(rw, 1) = ""

If CDate(.Cells(rw, 2)) = targetdate Then
key = .Cells(rw, 3).Value ' Sets the key to the item's sku Number

If dData.Exists(key) = False Then ' If this key does not exist in memory for this day then do the following:
DailyTotal = .Cells(rw, 6).Value
DailyTotal_len = DailyTotal
If DailyTotal_len = 1 Then
DailyTotal = DailyTotal & ".0"
End If
Item_Name = .Cells(rw, 4).Value
SKU_Num = .Cells(rw, 3).Value
Description = .Cells(rw, 5).Value
Worktime = Format(.Cells(rw, 6).Value, "0.0")
text = "[TOTAL TIME: " & DailyTotal & "; " & "CLIMAT: " & SKU_Num & "]; " & Description & " (" & Worktime & ")"
dData.Add key, text
Else
' Since this key already exists today, do the following:
SKU_Num = .Cells(rw, 3).Value
Description = .Cells(rw, 5).Value
Worktime = .Cells(rw, 6).Value
' Get the text already assigned to the daily key
oldtext = dData.item(key)
' Get the text that occupies digit places 2, 3, and 4 (the "Total Daily Time" so far)
If Mid(oldtext, 17, 1) = ";" Then
ten_plus = 1
oldtotal = Format(Mid(oldtext, 14, 3), "0.0")
Else
ten_plus = 0
oldtotal = Format(Mid(oldtext, 14, 4), "00.0")
End If
' Add the current entries' time to the old total
newtotal = Format((oldtotal + Worktime), "0.0")
newtotal_len = Len(newtotal)
If newtotal_len = 1 Then
newtotal = newtotal & ".0"
End If
' Replace the new total in place of the old total
If ten_plus = 1 Then
oldtext_len = Len(oldtext) - 16
Else
oldtext_len = Len(oldtext) - 17
End If
Mod_oldtext1 = Right(oldtext, oldtext_len)
Mod_oldtext2 = "[TOTAL TIME: " & newtotal & Mod_oldtext1
newtext = "; " & Description & " (" & Worktime & ")" 'Next
dData.item(key) = Mod_oldtext2 & newtext
End If

End If

rw = rw + 1
Loop

rw = rw + 2

For index = 1 To dData.Count
Sheet2.Cells(1 + index, 1) = dData.Items(index - 1)
'UserForm1.ListBox1.List = d.Items(index - 1)
Sheet2.Range("a1").Value = Sheet2.Range("a1").Value + 1
Next
End With
TotalEntries = Sheet2.Range("a1").Value
For i = 1 To TotalEntries
UserForm1.ListBox1.AddItem Sheet2.Cells(i + 1, "A").Value
Next
'
End Sub