Multiselect Listbox Help

[Rob342]

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]

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]

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]

Can you post the workbook, it would make it a lot simpler.

[Rob342]

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]

If you could do a mck-up Rob, it would be great. It is those worksheets that are of most interest.

[Rob342]

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]

Rob,

Is this what you want?

[Rob342]

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]

it keeps saving it as a PHP file

Did you update to IE 11.0 recently ?

[Rob342]

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]

That's your downloading problem.

[Bob Phillips]

I've made a few modifications, so see if this works any better

[Rob342]

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]

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]

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