Listbox with Multiple Columns - adding values in Column to Spreadsheet Cell

F

Flapjack

Board Regular
Joined
Aug 24, 2005
Messages
61
Office Version
  1. 365
Platform
  1. Windows
It's been several years since I've written VBA, so pretty rusty. I copied this code from elsewhere and it does what I want it to do except I want to add one thing.

I have a Userform with a macro that brings up a Listbox with 5 rows and 3 columns. There is a base product part number in cell C31 on the spreadsheet. The listbox displays the options that can be added to the part number. Column one in my source range is the suffix option code, column two is a description, and column three is the price adder. I've inserted a command button on the spreadsheet called "Select Options" that brings up the listbox. After the options are selected, the box closes (after they press the Select Options button again) and the option codes they selected are written to cell C23 ("ListBoxOutput") - each code is separated by "-". I then have a formula in cell C31 that adds the option codes to the base part number in cell C31. So for example, the base part number may be TDB-7001D, but after selecting their options, the final part number may be TDB-7001D-A-C-X.

I have a base price in cell D31. As the user adds the options, I want their price adders (column 3 in the source range) to be added to the value already in D31. The current macro code looks like:

VBA Code: 
Sub Rectangle1_Click()

Dim xSelShp As Shape, xSelLst As Variant, I, J As Integer
Dim xV As String
Set xSelShp = ActiveSheet.Shapes(Application.Caller)
Set xLstBox = ActiveSheet.ListBox1
If xLstBox.Visible = False Then
    xLstBox.Visible = True
    xSelShp.TextFrame2.TextRange.Characters.Text = "Select Options"
    xStr = ""
    xStr = Range("ListBoxOutput").Value
     
    If xStr <> "" Then
         xArr = Split(xStr, "-")
    For I = xLstBox.ListCount - 1 To 0 Step -1
        xV = xLstBox.List(I)
        For J = 0 To UBound(xArr)
            If xArr(J) = xV Then
              xLstBox.Selected(I) = True
              Exit For
            End If
        Next
    Next I
    End If
Else
    xLstBox.Visible = False
    xSelShp.TextFrame2.TextRange.Characters.Text = "Select Options"
    For I = xLstBox.ListCount - 1 To 0 Step -1
        If xLstBox.Selected(I) = True Then
        xSelLst = xLstBox.List(I) & "-" & xSelLst
        End If
    Next I
    If xSelLst <> "" Then
        Range("ListBoxOutput") = Mid(xSelLst, 1, Len(xSelLst) - 1)
    Else
        Range("ListBoxOutput") = ""
    End If
End If
End Sub

The Listbox looks like:
image002.png


I tried to insert this line in yellow for adding the option price adders but it didn't work:

CodeAdded.JPG


Thoughts?
 

Excel Facts

How to calculate loan payments in Excel?
Use the PMT function: =PMT(5%/12,60,-25000) is for a $25,000 loan, 5% annual interest, 60 month loan.
Sort by date Sort by votes
Listbox with 5 rows and 3 columns means the last column index is 2 not 3, so it should be:
VBA Code: 
xLstBox.List(I,2)
 
Upvote 0
Akuini said:
Listbox with 5 rows and 3 columns means the last column index is 2 not 3, so it should be:
VBA Code: 
xLstBox.List(I,2)
Click to expand...

Thank you for the reply. That worked! I also had my rows and columns backwards, so I had to change it to:

Cells(31, 4).Value = Cells(31, 4).Value + xLstBox.List(I, 2)

The only thing now is that if I go back into the select options box and change the selections, it doesn't reset back to the base value plus the new option prices. It just keeps adding up the options to a higher and higher total.
 
Upvote 0
The only thing now is that if I go back into the select options box and change the selections, it doesn't reset back to the base value plus the new option prices. It just keeps adding up the options to a higher and higher total.
Click to expand...

You mean initially Cells(31, 4) already has value & you want to always use the initial value when you add it to the new option prices?

Well, you need to keep the initial value in module level variable, say "xNumber".

VBA Code: 
Dim xNumber As Double 'this line must be at the top of userform code module

then in "Sub UserForm_Initialize"

VBA Code: 
Private Sub UserForm_Initialize()
xNumber = Cells(31, 4)
End Sub

then use it like this:
Cells(31, 4).Value = xNumber + xLstBox.List(I, 2)

Note:
Working with Userform, you should qualify the range with its sheet name, something like: sheets("Sheet1").Cells(31, 4).Value
in case the active sheet is not the intended sheet when you open the userform.
 
Upvote 0
Sorry, but I'm still not getting it. It seems like it should be an easy solution but I just can't quite get there. The code now looks like this:

VBA Code: 
Sub Rectangle1_Click()

Dim xSelShp As Shape, xSelLst As Variant, I, J As Integer
Dim xV As String
Dim xNumber As Double
Set xSelShp = ActiveSheet.Shapes(Application.Caller)
Set xLstBox = ActiveSheet.ListBox1
xNumber = 101.18

If xLstBox.Visible = False Then
    xLstBox.Visible = True
    xSelShp.TextFrame2.TextRange.Characters.Text = "Select Options"
    xStr = ""
    xStr = Range("ListBoxOutput").Value
     
    If xStr <> "" Then
         xArr = Split(xStr, "-")
    For I = xLstBox.ListCount - 1 To 0 Step -1
        xV = xLstBox.List(I)
        For J = 0 To UBound(xArr)
            If xArr(J) = xV Then
              xLstBox.Selected(I) = True
              Exit For
            End If
        Next
    Next I
    End If
Else
    xLstBox.Visible = False
    xSelShp.TextFrame2.TextRange.Characters.Text = "Select Options"
    For I = xLstBox.ListCount - 1 To 0 Step -1
        If xLstBox.Selected(I) = True Then
        xSelLst = xLstBox.List(I) & "-" & xSelLst
        Cells(31, 4).Value = xNumber + xLstBox.List(I, 2)
        End If
    Next I
    If xSelLst <> "" Then
        Range("ListBoxOutput") = Mid(xSelLst, 1, Len(xSelLst) - 1)
    Else
        Range("ListBoxOutput") = ""
    End If
End If
End Sub

So I added "xNumber = 101.18" where 101.18 is the base price I am working off of. Then I added Cells(31, 4).Value = xNumber + xLstBox.List(I, 2) down below which works fine for adding the option prices to the base price value. So I can add the option prices, but how do I get it to subtract the option prices as they deselect their options?
 
Upvote 0
So I can add the option prices, but how do I get it to subtract the option prices as they deselect their options?
Click to expand...

I don't understand what you mean by "they deselect their options".
Can you explain what you're doing by using an example, step by step? I need to understand the process.

And could you upload a sample workbook to a free site such as dropbox.com or google drive & then share the link here?
It will make it easier to understand & to test and find a solution.
 
Upvote 0
Having you look at the file would be great and I think would explain a lot. Much appreciated! Click on the Select Options button and choose some options. Then close the box and you will see the part number change in cell C31 and the price change in D31. Go back in the option box and deselect one or all of the options and choose different options. Do this a number of times and you will see that C31 with the part number changes correctly but the pricing doesn't. The total price in D31 should dynamically change whenever anyone makes a change to their option choices.

Google Dive Link

Hopefully the formatting looks OK. Looked good on the computer I created it on (Office 365) but then a little funny on a different computer (Office 2010).
 
Upvote 0
Ok, I hope I understand it correctly.
I amended "Sub Rectangle1_Click". Try it:

VBA Code: 
Sub Rectangle1_Click()

Dim xSelShp As Shape, xSelLst As Variant, I, J As Integer
Dim xV As String
Dim z As Double, xNumber As Double

Set xSelShp = ActiveSheet.Shapes(Application.Caller)
Set xLstBox = ActiveSheet.ListBox1
xNumber = 101.18
If xLstBox.Visible = False Then
    xLstBox.Visible = True
    xSelShp.TextFrame2.TextRange.Characters.Text = "Select Options"
    xStr = ""
    xStr = Range("ListBoxOutput").Value
     
    If xStr <> "" Then
         xArr = Split(xStr, "-")
    For I = xLstBox.ListCount - 1 To 0 Step -1
        xV = xLstBox.List(I)
        For J = 0 To UBound(xArr)
            If xArr(J) = xV Then
              xLstBox.Selected(I) = True
              Exit For
            End If
        Next
    Next I
    End If
Else
    xLstBox.Visible = False
    xSelShp.TextFrame2.TextRange.Characters.Text = "Select Options"
    z = 0
    For I = xLstBox.ListCount - 1 To 0 Step -1
        If xLstBox.Selected(I) = True Then
        xSelLst = xLstBox.List(I) & "-" & xSelLst
        z = z + xLstBox.List(I, 2)
        End If
    Next I
        Cells(31, 4).Value = xNumber + z
    If xSelLst <> "" Then
        Range("ListBoxOutput") = Mid(xSelLst, 1, Len(xSelLst) - 1)
    Else
        Range("ListBoxOutput") = ""
    End If
End If
End Sub
 
Upvote 0
Solution
PERFECT!! That works great and is exactly what I wanted. Thank you very much!
 
Upvote 0
You're welcome, glad to help & thanks for the feedback. :)
 
Upvote 0
You must log in or register to reply here.

Similar threads

B
  • Question Question
Need to modify VBA code to allow two ListBoxoutputs
Replies
1
Views
416
dmt32
D
B
  • Solved
Runtime error -214702024809 (80070057) only after protecting sheet
Replies
4
Views
2K
Blasirl
B
F
  • Locked
  • Question Question
ListBox Multiple Selections - Adding/Subtracting Cell Values
Replies
1
Views
752
Fluff
Fluff
D
  • Question Question
Copy dropdown list from one sheet to another
Replies
0
Views
622
DarkSmile
D
B
  • Question Question
Need help creating a second ListBoxOutput without corrupting the first.
Replies
3
Views
421
Blasirl
B

Forum statistics

Threads
1,223,445
Messages
6,172,176
Members
452,446
Latest member
walkman99

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top