Populating listbox based on two (or more) criteria

[jasonsweeney]

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.

 

[Guest]

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

 

[jasonsweeney]

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

 

[jasonsweeney]

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]

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

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]

Patrick,

When I try your code, the code:

Dim dData As Scripting.Dictionary

creates an "user defined type not defined" error

 

[jasonsweeney]

I am still having trouble (conceptually) with using the dictionary a
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 entrie
in Column B, from many different dates). I guess the date needs to b
the key.
(B) look next at column C for "Class Numbers". Problem is, I need thi
to also be a key....I need to collect all the individual entries tha
share a common class number, and apend them to one another in th
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 repea
step "B"....this for as many different Class_Numbers that were entere
that day (often in practice as many as 35, but usually = 15 differen
class_nums per day, with as many as 20 or more individual entries pe
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 o
Monday, I need 11 different entries at the end of the day. In thi
format:

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

The first number above (i.e. "4:31:00") needs to be the sum of th
indivdual time entries for that class_num for that day. The next tex
"Widget A (0934043)" represents the name of the component part, and th
number in the paranthetical is the Class_Num. NOW, the "text" item
described above in comment B needs to be added to the other tex
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 NE
HEAD ASSEMBLY (00:30:00)"

Any ideas would be appreciated...

 

[jasonsweeney]

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
______________
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