Help with vba list box loop update syntax

Hi all,

I have a 4 column multi-select list box that contains a key in column(0).

For the items selected inside my list box, I collect the key, and a code from a grouped option controls (x 32) then I loop through and update my table records based on a key match in column c of my excel table.

The following routine I developed is not giving me the result I need as it is only updating one row in my excel table. Can someone take a look at it and tell me where I am going wrong and provide some tips for improvement?

Private Sub cmdProcess_Click()
On Error GoTo Err_Handler
Dim wkb As String, i As Integer
Dim shtFrom As Worksheet, shtTo As Worksheet, startDate As String, endDate As String, rngTo As Range, rngFrom As Range, _
    lastrow As Long, response As Integer, msg As String, title As String, style As String
Dim y As Boolean, z As Boolean, intcounter As Integer, oCtrl As Control, k As String, uCode As String

If Me.lstTrans = vbNullString Then
    'if nothing was selected, tell user and let them try again ->>
     msg = "Cashbook could not detect the selection of any transactions." & vbCrLf & " " & vbCrLf & _
     "Please select which bank transactions you wish to process and try again."
     title = "Transaction selections not found"
     style = vbOKOnly + vbInformation
     response = MsgBox(msg, style, title)
     Me.lstTrans.Value = Null
     Exit Sub
    With ActiveWorkbook.Worksheets("Import")
    'Specifying selection counts ->>
                   'only controls
                  For Each oCtrl In frm_ledger_coding.fra1.Controls
                      'only option buttons
                      If TypeName(oCtrl) = "OptionButton" Then
                          ' Which one is checked?
                          If oCtrl.Value = True Then
                              ' What's the tag?
                              k = oCtrl.Tag
                              'Debug.Print "You have checked option " & oCtrl.Tag
                              Exit For
                          End If
                      End If
                intcounter = 2
                'Range I being the code ->>
                While .Range("H" & intcounter).Value <> ""
                    uCode = frm_ledger_coding.lstTrans.List(0, 0)
                    If .Range("C" & intcounter) = uCode Then

                        Select Case k

                        Case "ad" 'Advertisment
                           .Range("I" & intcounter).Value = "ad"
                        Case "bfc" 'bank charges
                           .Range("I" & intcounter).Value = "bfc"
                        Case "ca" 'caveat
                           .Range("I" & intcounter).Value = "ca"
                        Case "cf" 'creditor funding
                           .Range("I" & intcounter).Value = "cf"
                        Case "co" 'courier and storage
                           .Range("I" & intcounter).Value = "co"
                        Case "disb" 'disbursements
                           .Range("I" & intcounter).Value = "disb"
                        Case "div" 'dividends
                           .Range("I" & intcounter).Value = "div"
                        Case "eq" 'equipment
                           .Range("I" & intcounter).Value = "eq"
                        Case "fax" 'fascimile
                           .Range("I" & intcounter).Value = "fax"
                        Case "fs" 'file setup
                           .Range("I" & intcounter).Value = "fs"
                        Case "hp" 'house
                           .Range("I" & intcounter).Value = "hp"
                        Case "iag" 'shares
                           .Range("I" & intcounter).Value = "iag"
                        Case "ic" 'income contributions
                           .Range("I" & intcounter).Value = "ic"
                        Case "int" 'interest earned
                           .Range("I" & intcounter).Value = "int"
                        Case "intc" 'interest charges
                           .Range("I" & intcounter).Value = "intc"
                        Case "it" 'itsa/asfa fees
                           .Range("I" & intcounter).Value = "it"
                        Case "lc" 'local calls
                           .Range("I" & intcounter).Value = "lc"
                        Case "lf" 'legal fees
                           .Range("I" & intcounter).Value = "lf"
                        Case "me" 'meeting room fees
                           .Range("I" & intcounter).Value = "me"
                        Case "mo" 'mobile phone charges
                           .Range("I" & intcounter).Value = "mo"
                        Case "mv" 'motor vehicle expenses
                           .Range("I" & intcounter).Value = "mv"
                        Case "ot" 'other
                           .Range("I" & intcounter).Value = "ot"
                        Case "pp" 'photo copying and printing
                           .Range("I" & intcounter).Value = "pp"
                        Case "rc" 'realisations charges
                           .Range("I" & intcounter).Value = "rc"
                        Case "rem" 'renumeration
                           .Range("I" & intcounter).Value = "rem"
                        Case "rt" 'rent
                           .Range("I" & intcounter).Value = "rt"
                        Case "st" 'stamps
                           .Range("I" & intcounter).Value = "st"
                        Case "ta" 'travel allowance
                           .Range("I" & intcounter).Value = "ta"
                        Case "tf" 'train fares
                           .Range("I" & intcounter).Value = "tf"
                        Case "tt" 'funds from official trustee
                           .Range("I" & intcounter).Value = "tt"
                        Case "va" 'valuation
                           .Range("I" & intcounter).Value = "va"
                        Case "vc" 'voluntary contributon
                           .Range("I" & intcounter).Value = "vc"
                        Case "uk" 'unknown
                           .Range("I" & intcounter).Value = "uk"
                        End Select
                    End If
                    intcounter = intcounter + 1
    End With
End If 'Messages ->

   Exit Sub

   If Err.Number = 0 Then
      Resume ErrorHandlerExit
    msg = "An unexpected error has been detected" & Chr(13) & _
    "Description is: " & Err.Number & ", " & Err.Description & Chr(13) & _
    "Please note the above details before contacting support."
    title = "Cashbook error messaging"
    style = vbOKOnly + vbInformation
    response = MsgBox(msg, style, title)
      Resume ErrorHandlerExit
   End If
End Sub

Open in new window

Who is Participating?
KimputerConnect With a Mentor Commented:
So as I suspected, that is indeed the suspected line of code we have to change (have to be tomorrow though, it's after 2am for me.

You can also solve it by yourself though, make the code loop through ucodes gotten from selecteditems list instead of always being (0,0).
It's a bit out of context right now. Maybe you can upload the excel file (use dummy data is it's sensitive), and then describe the steps you take and what the result is, and what the results should be.
discogsAuthor Commented:
I have cut down the file and made dummy data to help. Click the button inside the sheet and it will load up the user form with the list.

Upgrade your Question Security!

Your question, your audience. Choose who sees your identity—and your question—with question security.

discogsAuthor Commented:
You should be able to see that when you select a code on the right of the form, then select either one or many of the rows in the list, column I is updated with the code that was selected based on the match of index in column(0) of the listbox and column(c) of the worksheet named import.

Hope this helps.
uCode = frm_ledger_coding.lstTrans.List(0, 0)

Open in new window

This is static and so it means it keeps looping and checking for the same uCode ? Is that correct ?

Also please note the whole SELECT case k section can be reduced to just one line (for readability reasons):

Range("I" & intcounter).Value = k

Open in new window

discogsAuthor Commented:
Okay, we have k sorted. It must be I am using excel 2010?

Regarding the uCode. It is not static. For each selected row in the list, I need to collect the uCode from column(0), then loop through column c of the worksheet until I find a match (which is where it comes from anyway..) then, update the corresponding cell in column I with k (the selected code..).

So, when I load the form, I can select like 20 names. Then I will choose an option box with a code. When I click process, all of the names are updated with the code in column I, using the index of column(0) and column c as the primary identifier.

Does this help?
discogsAuthor Commented:
Its okay. Tomorrow is fine. I am stuck right now. TA
discogsAuthor Commented:
Cracked it. With your help of course! Thanks heaps champ.
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.