• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 400
  • Last Modified:

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
Else
    
    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
                   Next
                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
                Wend
    End With
End If 'Messages ->


ErrorHandlerExit:
   Exit Sub

Err_Handler:
   If Err.Number = 0 Then
      Resume ErrorHandlerExit
   Else
    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

0
discogs
Asked:
discogs
  • 5
  • 3
1 Solution
 
KimputerCommented:
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.
0
 
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.

TA
Test.xlsm
0
 
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.
TA
0
Cloud Class® Course: Certified Penetration Testing

This CPTE Certified Penetration Testing Engineer course covers everything you need to know about becoming a Certified Penetration Testing Engineer. Career Path: Professional roles include Ethical Hackers, Security Consultants, System Administrators, and Chief Security Officers.

 
KimputerCommented:
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

0
 
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?
0
 
KimputerCommented:
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).
0
 
discogsAuthor Commented:
Its okay. Tomorrow is fine. I am stuck right now. TA
0
 
discogsAuthor Commented:
Cracked it. With your help of course! Thanks heaps champ.
TA
0
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.

Join & Write a Comment

Featured Post

Cloud Class® Course: Microsoft Office 2010

This course will introduce you to the interfaces and features of Microsoft Office 2010 Word, Excel, PowerPoint, Outlook, and Access. You will learn about the features that are shared between all products in the Office suite, as well as the new features that are product specific.

  • 5
  • 3
Tackle projects and never again get stuck behind a technical roadblock.
Join Now