PDA

View Full Version : [SOLVED] Multiselect Listbox Help



Rob342
12-18-2013, 02:02 AM
Hi
I am having a few problems with a Multi Select list box as follows
What I am trying to achieve, if a user selects 3 items, then write the values back to a sheet, these items are then removed from the listbox.
2nd time around the user selects all the other items.

The problem is the 2nd time around it is overwriting the data from the 1st selection, it works if all items are selected in one go, can somebody point me in the right direction?

Code for loading list box


Case "Service Reception"
With LBAuditP4
.List = Sheets("AC").Range("M2:U7").Value
.ColumnCount = UBound(.List, 2) + 1 'ubound(.list,2)= 8 columns + 1 = 9 columns
.ColumnWidths = "30pt;500pt;30pt;30pt;30pt;30pt;30pt;30pt;30pt"
End With

Code for selecting & removing items


With Me.LBAuditP4 '**
Select Case (Dept)

Case "Service Reception" ' Write details to DIndex sheet cells start at 6 to 11
For c = 0 To .ListCount - 1
If .Selected(c) Then
Worksheets(DIndex).cells(c + 1 + 5, "K").Value = Answer
Worksheets(DIndex).cells(c + 1 + 5, "L").Value = Worksheets("AC").Range("SRErrCode").cells(c + 1, 4).Value
Worksheets(DIndex).cells(c + 1 + 5, "M").Value = Worksheets("AC").Range("SRErrCode").cells(c + 1, 5).Value
Worksheets(DIndex).cells(c + 1 + 5, "N").Value = Worksheets("AC").Range("SRErrCode").cells(c + 1, 6).Value
Worksheets(DIndex).cells(c + 1 + 5, "O").Value = Worksheets("AC").Range("SRErrCode").cells(c + 1, 7).Value
Worksheets(DIndex).cells(c + 1 + 5, "P").Value = Worksheets("AC").Range("SRErrCode").cells(c + 1, 8).Value
Worksheets(DIndex).cells(c + 1 + 5, "Q").Value = Worksheets("AC").Range("SRErrCode").cells(c + 1, 9).Value
Worksheets(DIndex).cells(c + 1 + 5, "S").Value = Me.TxtAudNotes.Text
End If
Next c
Application.EnableEvents = False
For I = Me.LBAuditP4.ListCount - 1 To 0 Step -1 ' Remove items selected
If .Selected(I) = True Then
.RemoveItem (I) ' LBAuditP4.listindex+1
End If
Next I

Rob

Bob Phillips
12-18-2013, 03:30 AM
Where in that code are the selected listbox values written to the sheet? As far as I can see, you are just moving data from one sheet to another.

Rob342
12-18-2013, 03:54 AM
Hi xld

Yes in theory, the list box contains 6 questions which when selected the values from the defined range are updated to a ws DIndex, which can be (1 to 20)
example of one of the questions, extracted values are step1 step2 step3 etc
so if q1 to q3 selected the values are written to eg ws"1" q1 K6 to Q6, q2 K7 to Q7, q33 K8 to Q8
hope this makes sense


Code
Service Reception Audit Text Description
CE
Step 1
Step 2
Step 3
Step 4
Step 5
Load %


1
Correct Customer & Vehicle Details Obtained
N
s1
s2
s3
s4
s5
8


2
Customer Signature Obtained
Y
Y
Y
Y
Y
Y
16


3
Customer Concerns Recorded In A Clear and Conscise Manner incl. CCC's
N
N
N
Y
Y
Y
24


4
Customer Add-Ons Individually Referenced and Authorised, Repair Order Ruled Off
Y
N
N
Y
Y
Y
36


5
Vehicle Warranty Status Confirmed, Outstanding Recalls/Documented On Repair Order
N
N
N
Y
Y
Y
48


6
Vehicle Service / Repair History Checked Repair Order Endorsed as Repeat Repair
N
N
N
Y
Y
Y
60

Bob Phillips
12-18-2013, 04:18 AM
Can you post the workbook, it would make it a lot simpler.

Rob342
12-18-2013, 04:53 AM
Hi Bob
The workbook's too big to post, I could hard code the def range to each sheet
which still leaves the answer to the 3 option buttons either N, Y or NA and the auditors comments for the relevant question
column K = answer to option button, Auditors comments = col S
Here is the whole code for this routine if it helps, otherwise I can do you a mock up replicating the same thing ?


Private Sub CommandButton28_Click()
'// Audit1 Page 4 all departments automated
' listbox items deleted after update leaving only the ones not selected
' Load all the variables from AC sheet depending on Dept
' we now know which line to write back to with value LBAuditP4 and C
' Need to load all the job numbers that have been input on Audit !!!
Dim ws As Worksheet
Dim DIndex As String
Dim c As Integer
Dim I As Integer
Dim listindex As Long
Dim Dept As String
Dim Answer As String
Dim check As String
Dim r As Integer
Dim x As Integer
Dim N As Integer
N = 0: r = 0: c = 0: I = 0: x = 0
Dim cno As Variant

' chk if any selection made 1st
With Me.LBAuditP4
For r = 0 To .ListCount - 1
If .Selected(r) = True Then
x = x + 1
End If
Next r
If x = 0 Then
MsgBox "No Selection, Please Select A Single or Multiple Questions", , "No Selection Audit Questions"
Call Clr_LBAudit
Exit Sub
End If
End With
If x > 1 And OptionButton94.Value = True Then
MsgBox " You Cannot Select No, If Your Selection Is > 1 !", , "No, Not Applicable To Multiple Questions"
For N = 0 To LBAuditP4.ListCount - 1
Me.LBAuditP4.Selected(N) = False
Next N
N = 0
Call Clr_LBAudit
Exit Sub
End If
check = MsgBox("Correct Questions & Audit Compliant ? Then Click YES To Accept or NO to Abort ! ", _
vbYesNo + vbInformation, "Confirmation Of Job Number")
If check = vbNo Then
For N = 0 To LBAuditP4.ListCount - 1
Me.LBAuditP4.Selected(N) = False
Next N
N = 0
Call Clr_LBAudit
Exit Sub
End If
Dept = Me.CboAudDept.Text
' Yes Or No or NA answers here 94 = NO 95 = YES NA = 103 ! updated to include NA 19/10/13
If OptionButton94.Value = True Then Answer = "N"
If OptionButton95.Value = True Then Answer = "Y"
If OptionButton103.Value = True Then Answer = "NA"
'// Get DIndex variable from AudSum sheet so we know which audit sheet its going to
DIndex = Worksheets("AudSum").cells(3, "AW").Value

'// Start writing it back to the appropriate sheet using the DIndex variable
Set ws = Worksheets(DIndex)
With ws
If DIndex = 20 And .cells(52, "K").Value <> "" Then GoTo Final
If .cells(3, "C").Value = "" Then
.cells(3, "C").Value = Me.TxtAudJobNo.Value: .cells(3, "G").Value = Me.TxtAudJobNo.Value
.cells(3, "K").Value = CLng(CDate(Me.TxtAudJCDate.Value)): .cells(3, "K").NumberFormat = "DD/MM/YYYY"
.cells(3, "S").Value = Me.TxtAudLab.Value
.cells(3, "U").Value = Me.TxtAudMat.Value: .cells(3, "X").Value = Me.TxtAudTotal.Value
End If
End With

With Me.LBAuditP4 '**
Select Case (Dept)

Case "Service Reception" ' Write details to DIndex sheet cells start at 6 to 1
For c = 0 To .ListCount - 1
If .Selected(c) Then
Worksheets(DIndex).cells(c + 1 + 5, "K").Value = Answer
Worksheets(DIndex).cells(c + 1 + 5, "L").Value = Worksheets("AC").Range("SRErrCode").cells(c + 1, 4).Value
Worksheets(DIndex).cells(c + 1 + 5, "M").Value = Worksheets("AC").Range("SRErrCode").cells(c + 1, 5).Value
Worksheets(DIndex).cells(c + 1 + 5, "N").Value = Worksheets("AC").Range("SRErrCode").cells(c + 1, 6).Value
Worksheets(DIndex).cells(c + 1 + 5, "O").Value = Worksheets("AC").Range("SRErrCode").cells(c + 1, 7).Value
Worksheets(DIndex).cells(c + 1 + 5, "P").Value = Worksheets("AC").Range("SRErrCode").cells(c + 1, 8).Value
Worksheets(DIndex).cells(c + 1 + 5, "Q").Value = Worksheets("AC").Range("SRErrCode").cells(c + 1, 9).Value
Worksheets(DIndex).cells(c + 1 + 5, "S").Value = Me.TxtAudNotes.Text
End If
Next c
Application.EnableEvents = False
For I = Me.LBAuditP4.ListCount - 1 To 0 Step -1 ' Remove items selected
If .Selected(I) = True Then
.RemoveItem (I) ' LBAuditP4.listindex+1
End If
Next I
Application.EnableEvents = True
Call Clr_LBAudit
If LBAuditP4.ListCount = 0 Then
Me.CboAudDept.Text = "W/Shop Control Pre Repair"
End If
Case "W/Shop Control Pre Repair" ' Write details to DIndex sheet cells start at 13 to 19
For c = 0 To .ListCount - 1
If .Selected(c) = True Then
Worksheets(DIndex).cells(c + 1 + 12, "K").Value = Answer
Worksheets(DIndex).cells(c + 1 + 12, "L").Value = Worksheets("AC").Range("WCPRErrCode").cells(c + 1, 4).Value
Worksheets(DIndex).cells(c + 1 + 12, "M").Value = Worksheets("AC").Range("WCPRErrCode").cells(c + 1, 5).Value
Worksheets(DIndex).cells(c + 1 + 12, "N").Value = Worksheets("AC").Range("WCPRErrCode").cells(c + 1, 6).Value
Worksheets(DIndex).cells(c + 1 + 12, "O").Value = Worksheets("AC").Range("WCPRErrCode").cells(c + 1, 7).Value
Worksheets(DIndex).cells(c + 1 + 12, "P").Value = Worksheets("AC").Range("WCPRErrCode").cells(c + 1, 8).Value
Worksheets(DIndex).cells(c + 1 + 12, "Q").Value = Worksheets("AC").Range("WCPRErrCode").cells(c + 1, 9).Value
Worksheets(DIndex).cells(c + 1 + 12, "S").Value = Me.TxtAudNotes.Text
End If
Next c
Application.EnableEvents = False
For I = Me.LBAuditP4.ListCount - 1 To 0 Step -1 ' Remove items selected
If .Selected(I) = True Then
.RemoveItem (I)
End If
Next I
Application.EnableEvents = True
Call Clr_LBAudit
If LBAuditP4.ListCount = 0 Then
Me.CboAudDept.Text = "Technician"
End If
Case "Technician" ' Write details to DIndex sheet cells start at 21 to 28
For c = 0 To .ListCount - 1
If .Selected(c) = True Then
Worksheets(DIndex).cells(c + 1 + 20, "K").Value = Answer
Worksheets(DIndex).cells(c + 1 + 20, "L").Value = Worksheets("AC").Range("Tech").cells(c + 1, 4).Value
Worksheets(DIndex).cells(c + 1 + 20, "M").Value = Worksheets("AC").Range("Tech").cells(c + 1, 5).Value
Worksheets(DIndex).cells(c + 1 + 20, "N").Value = Worksheets("AC").Range("Tech").cells(c + 1, 6).Value
Worksheets(DIndex).cells(c + 1 + 20, "O").Value = Worksheets("AC").Range("Tech").cells(c + 1, 7).Value
Worksheets(DIndex).cells(c + 1 + 20, "P").Value = Worksheets("AC").Range("Tech").cells(c + 1, 8).Value
Worksheets(DIndex).cells(c + 1 + 20, "Q").Value = Worksheets("AC").Range("Tech").cells(c + 1, 9).Value
Worksheets(DIndex).cells(c + 1 + 20, "S").Value = Me.TxtAudNotes.Text
End If
Next c
Application.EnableEvents = False
For I = Me.LBAuditP4.ListCount - 1 To 0 Step -1 ' Remove items selected
If .Selected(I) = True Then
.RemoveItem (I)
End If
Next I
Application.EnableEvents = True
Call Clr_LBAudit
If LBAuditP4.ListCount = 0 Then
Me.CboAudDept.Text = "Parts"
End If
' Amended here Post wc now after parts 19/10/13
Case "Parts" ' Write details to DIndex sheet cells start at 30 to 35
For c = 0 To .ListCount - 1
If .Selected(c) = True Then
Worksheets(DIndex).cells(c + 1 + 29, "K").Value = Answer
Worksheets(DIndex).cells(c + 1 + 29, "L").Value = Worksheets("AC").Range("Parts").cells(c + 1, 4).Value
Worksheets(DIndex).cells(c + 1 + 29, "M").Value = Worksheets("AC").Range("Parts").cells(c + 1, 5).Value
Worksheets(DIndex).cells(c + 1 + 29, "N").Value = Worksheets("AC").Range("Parts").cells(c + 1, 6).Value
Worksheets(DIndex).cells(c + 1 + 29, "O").Value = Worksheets("AC").Range("Parts").cells(c + 1, 7).Value
Worksheets(DIndex).cells(c + 1 + 29, "P").Value = Worksheets("AC").Range("Parts").cells(c + 1, 8).Value
Worksheets(DIndex).cells(c + 1 + 29, "Q").Value = Worksheets("AC").Range("Parts").cells(c + 1, 9).Value
Worksheets(DIndex).cells(c + 1 + 29, "S").Value = Me.TxtAudNotes.Text
End If
Next c
Application.EnableEvents = False
For I = Me.LBAuditP4.ListCount - 1 To 0 Step -1 ' Remove items selected
If .Selected(I) = True Then
.RemoveItem (I)
End If
Next I
Application.EnableEvents = True
Call Clr_LBAudit
If LBAuditP4.ListCount = 0 Then
Me.CboAudDept.Text = "W/Shop Control Post Repair"
End If

Case "W/Shop Control Post Repair" ' Write details to DIndex sheet cells start at 37 to 45
For c = 0 To .ListCount - 1
If .Selected(c) = True Then
Worksheets(DIndex).cells(c + 1 + 36, "K").Value = Answer
Worksheets(DIndex).cells(c + 1 + 36, "L").Value = Worksheets("AC").Range("WCPOSErrCode").cells(c + 1, 4).Value
Worksheets(DIndex).cells(c + 1 + 36, "M").Value = Worksheets("AC").Range("WCPOSErrCode").cells(c + 1, 5).Value
Worksheets(DIndex).cells(c + 1 + 36, "N").Value = Worksheets("AC").Range("WCPOSErrCode").cells(c + 1, 6).Value
Worksheets(DIndex).cells(c + 1 + 36, "O").Value = Worksheets("AC").Range("WCPOSErrCode").cells(c + 1, 7).Value
Worksheets(DIndex).cells(c + 1 + 36, "P").Value = Worksheets("AC").Range("WCPOSErrCode").cells(c + 1, 8).Value
Worksheets(DIndex).cells(c + 1 + 36, "Q").Value = Worksheets("AC").Range("WCPOSErrCode").cells(c + 1, 9).Value
Worksheets(DIndex).cells(c + 1 + 36, "S").Value = Me.TxtAudNotes.Text
End If
Next c
Application.EnableEvents = False
For I = Me.LBAuditP4.ListCount - 1 To 0 Step -1 ' Remove items selected
If .Selected(I) = True Then
.RemoveItem (I)
End If
Next I
Application.EnableEvents = True
Call Clr_LBAudit
If LBAuditP4.ListCount = 0 Then
Me.CboAudDept.Text = "Warranty Administration"
End If

Case "Warranty Administration" ' Write details to DIndex sheet cells start at 47 to 52
For c = 0 To .ListCount - 1
If .Selected(c) = True Then
Worksheets(DIndex).cells(c + 1 + 46, "K").Value = Answer
Worksheets(DIndex).cells(c + 1 + 46, "L").Value = Worksheets("AC").Range("WarrAdmin").cells(c + 1, 4).Value
Worksheets(DIndex).cells(c + 1 + 46, "M").Value = Worksheets("AC").Range("WarrAdmin").cells(c + 1, 5).Value
Worksheets(DIndex).cells(c + 1 + 46, "N").Value = Worksheets("AC").Range("WarrAdmin").cells(c + 1, 6).Value
Worksheets(DIndex).cells(c + 1 + 46, "O").Value = Worksheets("AC").Range("WarrAdmin").cells(c + 1, 7).Value
Worksheets(DIndex).cells(c + 1 + 46, "P").Value = Worksheets("AC").Range("WarrAdmin").cells(c + 1, 8).Value
Worksheets(DIndex).cells(c + 1 + 46, "Q").Value = Worksheets("AC").Range("WarrAdmin").cells(c + 1, 9).Value
Worksheets(DIndex).cells(c + 1 + 46, "S").Value = Me.TxtAudNotes.Text
End If
Next c
Application.EnableEvents = False
For I = Me.LBAuditP4.ListCount - 1 To 0 Step -1 ' Remove items selected
If .Selected(I) = True Then
.RemoveItem (I)
End If
Next I
Application.EnableEvents = True
If LBAuditP4.ListCount = 0 And DIndex = 20 Then GoTo Final 'page 20 sheet & all questions answered

If LBAuditP4.ListCount = 0 Then 'wrap it up for this job card
check = MsgBox("Audit Complete For This Job Card :" & vbNewLine & _
" Do You Want To Select Another Job Card / Interrupt Audit At This Point ?", _
vbYesNo + vbInformation, "Confirm Another Job Card")
If check = vbYes Then
DIndex = DIndex + 1 ' update to next sheet
Worksheets("AudSum").cells(3, "AW").Value = DIndex
'clear AuditP4 sheet & set back to job number same dealer
Call Clr_LBAudit
Call Clr_P13_Data
Application.EnableEvents = False
Me.CboAudDept = ""
OptionButton92.Enabled = False
OptionButton93.Enabled = False
OptionButton103.Enabled = False
Me.TxtAudJobNo.Enabled = True
Me.TxtAudJobNo.Text = ""
Me.TxtAudJobNo.SetFocus
Application.EnableEvents = True
MsgBox "Please Select The Next Job Card or Suspend Audit At This Point ?", , "Continuation Of Audit Exit"
CommandButton28.Enabled = False
Me.LBAuditP4.Enabled = False
CommandButton8.Enabled = True
Exit Sub
End If ' answer no end here
GoTo Final
End If
End Select
End With
'// This where we need to updates vales on Multipage2 Page 15
'Me.Frame42.Enabled = False
'FrmAudit.MultiPage2.Value = 2
' Call CommandButton42_Click

' Need to do clear up here clear
'Call Clr_LBAudit
Exit Sub
Final:
MsgBox "End Of Audit For This Dealer, Please Complete Claim Values & Debits", , "Proceed To Claim Values & Debits"
FrmAudit.MultiPage2.Value = 2
Call CommandButton42_Click

' Me.MultiPage1.Page12.Visible = True
'Me.MultiPage1.Value = 4
' Me.MultiPage1.Page4.Visible = False
End Sub

Bob Phillips
12-18-2013, 06:18 AM
If you could do a mck-up Rob, it would be great. It is those worksheets that are of most interest.

Rob342
12-18-2013, 01:55 PM
Hi Bob

Please find attached the "Mock Up"
If you select Service Reception from the department for a start, I have left the data on chk sheet claim 1 this is how it should be regardless of which questions are selected and at what stage. I did notice if you do not delete the questions after selection then it works all ok
Something to get your teeth into?

Bye the way thanks for time most appreciated
Rob

Bob Phillips
12-18-2013, 06:22 PM
Rob,

Is this what you want?

Rob342
12-19-2013, 03:06 AM
Hi Bob
Can't download the file, it keeps saving it as a PHP file don't know whether its my computer or a problem on vbax site
Will try again later at home on a different computer and let you know ok
Rob

snb
12-19-2013, 07:11 AM
it keeps saving it as a PHP file

Did you update to IE 11.0 recently ?

Rob342
12-19-2013, 07:40 AM
Bob
Downloaded the file from another computer, ran a few tests during dinner hour

Have changed to multiselect from extended

If all questions are selected then it works ok and audit comments appear in the correct fields
If you select Q1 & update, Q2 & update to Q6 then it puts all the answers from q1 in all fields, audit comments are correct
if you select Q1 & Q2 & update then select Q3 to Q6 & update then it puts in the answers for Q1 in Q3 fields
Q4 put the answers in for Q2, Q5 put in the answers for Q3, Q6 put in the answers for Q4
All the auditor comments are in the correct fields?

If you select Q1,Q2 and Q3 & update and look at the sheet it all ok, but when you select the Q2,4,5 & update
Q2 on the sheets contains the answers for Q1
Q4 contains the answers for Q2
Q5 contains the answers for Q3

It seems like whatever you select 1st time around it does what its supposed to, but then it goes !?? up after that.
Impressed with coding you will have to explain later

Rob

snb
Yes I'm on IE 11.00

snb
12-19-2013, 08:28 AM
That's your downloading problem.

Bob Phillips
12-19-2013, 05:04 PM
I've made a few modifications, so see if this works any better

Rob342
12-20-2013, 06:13 AM
Hi Bob

Changes did not make any difference, i got the the mathermatical brain engaged this morning and did some more testing on the variables, what i noticed was the (c) does not remain constant after the 1st update but idx does and remains the same value to the question number.

Have amended the following routine and guess what it works a treat now!


With ThisList

For c = 0 To .ListCount - 1

If .Selected(c) = True Then
'idx remains constant to question no (c) does not after pressing update button
idx = .List(c, 0)
Worksheets(DIndex).Cells(idx + RowOff, "K").Value = Answer
Worksheets(DIndex).Cells(idx + RowOff, "L").Value = Target.Cells(idx, 4).Value
Worksheets(DIndex).Cells(idx + RowOff, "M").Value = Target.Cells(idx, 5).Value
Worksheets(DIndex).Cells(idx + RowOff, "N").Value = Target.Cells(idx, 6).Value
Worksheets(DIndex).Cells(idx + RowOff, "O").Value = Target.Cells(idx, 7).Value
Worksheets(DIndex).Cells(idx + RowOff, "P").Value = Target.Cells(idx, 8).Value
Worksheets(DIndex).Cells(idx + RowOff, "Q").Value = Target.Cells(idx,9).Value
Worksheets(DIndex).Cells(idx + RowOff, "S").Value = Me.TxtAudNotes.Text
End If
Next c


A couple of questions
1 idx = .list(c,0) is this looking at the array for the list?
2 RowOff how does this know where to look for the data?
3 Target.cells does this look at the defined range?

Regards
Rob

Bob Phillips
12-20-2013, 09:22 AM
That is very odd, because it worked perfectly for me (as far as I understood what it was supposed to do). c is the index within the listbox, whereas idx resolves to the index within the original list, neither should remain constant, but they are not necessarily the same because you remove items from the listbox. I thought about making that change, and decided it wasn't necessary, which my testing confirmed for me.

As to those questions,
1 - you load the list array with the index number, then the text, then the numbers. .List(c, 0) returns the first column of that array, namely the index number
2 - that is essentially hard-coded, set when this procedure is called in the cmdUpdate_Click procedure, depending upon the value selected in the cboAutoDept dropdown
3 - Target is passed as the appropriate range on the lists worksheet, again specifically set depending upon the value selected in the cboAutoDept dropdown. Cells just defines the Cells property of that range which is passed the row and column numbers to identify a particular cell within Target.

Rob342
12-20-2013, 11:47 AM
Hi Bob

Gave it a good blast today with the changes all works as it should every time, so I can carry on now & get the Project finished.
It beats going back to single selections.
Thanks for the answers to the questions its made it a lot clearer now.

Thanks for your time on this most appreciated....... I think I owe you a large beer.......
Have a good Xmas
Regards
Rob