Private Sub txtTotal1_Change()
Dim Final As Integer
If cbOldf_Change() Then
olf1 = cbOldf.ActiveCell.Offset(0, 1)
Final = oldf_col * quantity
ElseIf cbHaribo1_Change() Then
haribo1 = cbHaribo1.ActiveCell.Offset(0, 1) + 1
Final = haribo_col * quantity
ElseIf cbOldf_Change() = cbHaribo1_Change() Then
oldf_1 = cbOldf.ActiveCell.Offset(0, 1) + 1
haribo1 = cbHaribo1.ActiveCell.Offset(0, 1) + 1
Final = oldf_1 + haribo1 * quantity
End If
If txtQuantity1_Change() Then
txtTotal.Value = Final
End Sub
I am new at vba. I have two worksheets for seperate products (haribo and old favourites) I have combo boxes to grab products from those worksheets and a text box to enter quantities. In the products worksheets the product name is in column A and the price is in column B. What I want to achieve is to be able to select a product name from the combo box, enter a quantity in the text box and have the total price be calculated and then displayed in a "total" textbox.
I am new at this so please look past my awful code, I have given it an honest 5 or so hours of effort and I am now at my wits end! I would love some help or to be pointed in the right direction please.
EDIT: Here is my workbook https://www.dropbox.com/s/49iym4exbcgmhcq/Main%20Page.xlsm
I am doing this for college as you may guess by looking at it
Try to use this code to set the total:
Private Sub SetTotal()
Dim dblTotal As Double
Dim dblQuantity As Double
If IsNumeric(Me.txtQuantity1) Then
dblQuantity = CDbl(Me.txtQuantity1)
End If
If cbHaribo1.Value <> "" Then
dblTotal = dblQuantity * GetPrice(Sheets("HARIBO").Range("A:B"), cbHaribo1.Value)
End If
If Me.cbOldf.Value <> "" Then
dblTotal = dblTotal + dblQuantity * GetPrice(Sheets("OLDFAVORITES").Range("A:B"), cbOldf.Value)
End If
Me.txtTotal1 = Format(dblTotal, "0.00")
End Sub
Private Function GetPrice(rng As Range, strProduct As String) As Double
On Error GoTo ErrorHandler
GetPrice = WorksheetFunction.VLookup(strProduct, rng, 2, False)
Exit Function
ErrorHandler:
GetPrice = 0
End Function
To trigger this code, you need to insert these events:
Private Sub cbHaribo1_Change()
SetTotal
End Sub
Private Sub cbOldf_Change()
SetTotal
End Sub
Private Sub txtQuantity1_Change()
SetTotal
End Sub
Note that the form is a bit ambiguous - at the moment the code applies to quantity to both, Haribo and Old Favorites. Better you either prodive a second quantity field - or insert an option box that greys out Haribo or Old Favorites...
Related
I have the following userform:
Using the code below I can save the names of each selected checkbox into a sheet. The value will be saved in the same column, but on different rows (of course), as more than 1 checkbox can be selected.
Dim indProdWs As Worksheet
Dim ctl As Control
Dim i As Long
Set indProdWs = tWb.Worksheets("INDICATION-PRODUCT")
i = 4
' This is the row where i want to save the first value
For Each ctl In seg_multipage.Pages(1).Controls
If TypeName(ctl) = "CheckBox" Then
If ctl.Value = True Then
indProdWs.Cells(i, 9) = ctl.Caption: i = i + 1
End If
End If
Next ctl
However, as you can see in the first image, for each row of products there's a label.
This is what I want to accomplish:
If Product 22 in the second row is selected, then I want the name to be saved on the cell with the following format:
Label2 - Product22
Or if Product 51 in the second row is selected:
Label 5 - Product 51
As you can see, the label number always matches the first digit of the product. I tried using that as a variable, but I haven't been successful.
Thank you for any help you can give me!
is the name actually "Product22" or this just an example? – Siddharth Rout 6 mins ago
#SiddharthRout just an example, but the format is similar. An actual name is seg_cb_selInd_22 (for example). – soraia635 1 min ago
Is this what you are trying?
Change the For - Next code to the below
For Each ctl In seg_multipage.Pages(1).Controls
If TypeName(ctl) = "CheckBox" Then
If ctl.Value = True Then
indProdWs.Cells(i, 9) = Controls("seg_l_selInd_" & _
GetNumber(ctl.Name)).Caption & _
" - " & _
ctl.Name
i = i + 1
End If
End If
Next ctl
and then add this function to your code
Private Function GetNumber(s As String)
Dim numb As Long
Dim i As Long
For i = 1 To Len(s)
Select Case Mid(s, i, 1)
Case 0 To 9
numb = Mid(s, i, 1)
Exit For
End Select
Next
GetNumber = numb
End Function
Note: This function assumes that you will pass an Alphanumeric string to it.
I have a big list with full addresses in excel. Each address has a single cell. I am having trouble creating a formula to grab the street name to put in another cell and grabbing the city to put in a different cell.
Here is example cases of what my data looks like
12 Apple RD Harwich, MA 11111
1213 Strawberry Crossing Loop Tampa, FL 22222
123 Pear Dr. Colorado Springs, CO 33333
12345 RIVERSIDE DR Lowertown, PA 44444
6232 N Rockstar ST Philadelphia, PA 44444
123 TOWN ST Plympton, MA 55555
I didn't find a quick and easy way to solve your problem but here is a way to do the required work efficiently and fast - probably more so than if you spend time on getting code that will, at best, only produce a result that needs to be reviewed.
In a nutshell, the code offered here will create a textbox for each cell as you click on it. It's a textbox because it offers capabilities a cell doesn't have. In the text box you enter a single comma, to separate street address from city, and press enter. The split is done on the spot, is immediately editable, and the textbox moves to the next line.
The code can handle more commas. And it can handle each part individually. I have demonstrated this on the state and ZIP code part. There is a note in the code where you can remove this extra. The code also adds the comma (and any other changes made at that time) to the original data. There is another note in the code where you can remove a line to keep the original data untouched.
The code is a little elaborate and, at the same time, rough around the edges because it was adapted from another project. As it is now in consists of 2 parts. The first part contains event procedures which call other procedures in the other part. The latter also contains supporting functions for itself. The first part must be installed in the code module of the worksheet on which you want the action. That is the worksheet with the original addresses in them. You can install this same code behind several worksheets in the same workbook. Here is part 1.
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
' 069
Const StopAction As Boolean = False ' change to TRUE to stop
Const SourceClm As Long = 1 ' column containing the data
If StopAction Or Target.Column <> SourceClm Then
KillTbx Target
Else
SetTbx Target.Cells(1)
End If
End Sub
Private Sub Splitter_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, _
ByVal Shift As Integer)
' NIC 047 09 Jun 2020
KeyCode = KeyUpEvent(KeyCode, Shift)
End Sub
Please observe the two constants at the top. You can set them to suit your needs. StopAction, if TRUE will disable the creation of text boxes, in fact returning your worksheet to its original behaviour. SourceClm specifies the column in which you have your original data. In my trials that was column A, identified by its number, 1. If you have several installations in the same workbook these settings can be individually different.
The code below goes into a standard code module. That is a module you have to insert. By default VBA will name it Module1. I recommend to rename it suitably. I named mine STO_62962096 which will help me find this thread again if ever needed.
Option Explicit
Private Const MagName As String = "Splitter"
Sub SetTbx(Target As Range)
' 069
Dim Tbx As OLEObject ' the TextBox being created
Dim BackColor As Long ' background color
Dim FontColor As Long ' font color
BackColor = 16777152 ' = sky blue
FontColor = vbBlack ' = 0
On Error Resume Next
Set Tbx = ActiveSheet.OLEObjects(MagName)
If Err Then
Set Tbx = Target.Worksheet.OLEObjects _
.Add(ClassType:="Forms.TextBox.1", _
Link:=False, _
DisplayAsIcon:=False, _
Left:=100, Top:=100, _
Width:=100, Height:=20)
End If
With Tbx
With .Object
.BackColor = BackColor
.SpecialEffect = fmSpecialEffectFlat
.BorderStyle = fmBorderStyleSingle
.IntegralHeight = False
.ForeColor = FontColor
.Font.Size = Target.Font.Size
.Text = Target.Value
End With
.Left = Target.Left
.Top = Target.Top
.Width = Target.Width
.Height = (Target.Offset(1).Top - .Top)
.Name = MagName
.Activate
End With
End Sub
Sub KillTbx(Target As Range)
' 069
Dim Tbx As OLEObject ' TextBox
On Error Resume Next
Set Tbx = Target.Worksheet.OLEObjects(MagName)
If Err = 0 Then Tbx.Delete
Err.Clear
Target.Select
End Sub
Function KeyUpEvent(ByVal KeyCode As Integer, _
ByVal Shift As Integer) As Integer
' 069
Dim Tbx As OLEObject
Dim n As Long ' offset
Set Tbx = ActiveSheet.OLEObjects(MagName)
If KeyCode = 13 Then ' Enter
With Tbx
SplitAddress .Object.Text, .TopLeftCell.Row
' remove the next line to KEEP original data
.TopLeftCell.Value = .Object.Text
KeyCode = 40 ' move to next row
End With
End If
Select Case KeyCode
Case 38, 40 ' Up-arrow / Down-arrow
n = IIf(KeyCode = 38, -1, 1)
Tbx.TopLeftCell.Offset(n).Select
Tbx.Object.Text = ActiveCell.Value
Case 9 ' tab: move right/left
n = IIf(Shift, -1, 1)
Tbx.TopLeftCell.Offset(, n).Select
Tbx.Object.Text = ActiveCell.Value
End Select
KeyUpEvent = KeyCode
End Function
Private Sub SplitAddress(ByVal Txt As String, _
ByVal Rt As Long)
' 069
Const TgtClm As Long = 4 ' first target column (change to suit)
Const StateClm As Long = 7 ' State followed by ZIP (change to suit)
Dim Sp() As String ' address array
Dim Ct As Long ' target column
Dim Arr As Variant ' output array
If Len(Txt) Then
ReDim Arr(1 To StateClm - TgtClm + 2)
Sp = Split(Txt, ",")
For Ct = 0 To UBound(Sp)
Arr(Ct + 1) = Trim(Sp(Ct))
Next Ct
' remove the next block of 5 lines to NOT separate state & ZIP
Sp = Split(Trim(Replace(Sp(Ct - 1), " ", " ")))
Arr(Ct) = ""
For Ct = 0 To UBound(Sp)
Arr(Ct + StateClm - TgtClm + 1) = Trim(Sp(Ct))
Next Ct
Cells(Rt, TgtClm).Resize(, UBound(Arr)).Value = Arr
Columns(TgtClm).Resize(, StateClm - TgtClm + 2).AutoFit
End If
End Sub
Look for the procedure SplitAddress and adjust the two constants you find there. The code splits the address into a, theoretically, unlimited number of parts. The first of these will be written to the column named TgtClm, 4 in the above code, which identifies column D. The State/ZIP combination has its own similar design and therefore its own first column (the first of 2 in this case). If you don't use this feature (you can disable it in this same procedure) set the constant StateClm to a number at least equal to the maximum number of splits you expect.
Note that the code creates an array with StateClm - TgtClm + 2 elements. If you only want 3 columns, as per your question, StateClm - TgtClm + 2 must be => 3. To the right of the result the code will over-write existing data for as many columns as this formula specifies.
Hi I would like to sum these 3 variables and auto-populate the sum value to another variable - txtTotalMonthly Salary on Excel.
txtLastMonthlyDrawnSalary
txtAWS
txtAllowance
Could anyone advise please?
Private Sub txtLastMonthlyDrawnSalary_Change()
If Me.txtLastMonthlyDrawnSalary.Value <> "" Then
Dim Product As Long
Product = Me.txtLastMonthlyDrawnSalary.Value * 12
Me.txtLastAnnualDrawnSalary.Value = Product
End If
If Me.txtLastMonthlyDrawnSalary.Value <> "" Then
Dim Sum As Long
Me.txtLastMonthlyDrawnSalary.Value Me.txtAWS.Value + Me.txtAllowance.Value = Sum
End If
End Sub
First of all, as good practice, I would declare the variables all at the beginning.
so start with DIM product ect...
also, what is "Me"
Also, If txtlastmonthdrawnsalary is numeric, you don't need to add ".value" at the end.
Just to avoid any possible errors I added "z" at the end of your variable to distiguish them from VB coomands.
I would start with the following, if that still doesn't work, let's see where it breaks:
Private Sub txtLastMonthlyDrawnSalary_Change()
Dim Productz As Long, Sumz As Long, txtLastMonthlyDrawnSalary as long, txtLastAnnualDrawnSalary as long
If not txtLastMonthlyDrawnSalary = "" Then
Productz = txtLastMonthlyDrawnSalary * 12
txtLastAnnualDrawnSalary = Productz
End If
If not txtLastMonthlyDrawnSalary = "" Then
sumz = txtLastMonthlyDrawnSalary + txtAWS + txtAllowance
End If
End Sub
So I am new to the forms side of the VBA coding and I seem to be struggling a bit with this one.
What I have did was follow this tutorial:
https://www.excel-easy.com/vba/examples/multiple-list-box-selections.html
And I have adapted it in a way that suits my needs, but now I am having an issue or two that I do not understand how I can resolve.
The code in the tutorial adds two list boxes to a form and then the add button copy items from the first listbox to the second and the remove button removes items from the second listbox.
The problem is that you can add a specific item more than once, and considering I would like to use the values in the second listbox, this is a problem as I need only unique values.
The code below is what I have come up with so far, but I am getting an error:
Private Sub btn_Add_Filter_Click()
For i = 0 To lbx_Filters_List.ListCount - 1
If lbx_Filters_List.Selected(i) = True Then
For X = 0 To lbx_Filters.ListCount
If Not IsError(lbx_Filters.List(X)) Then
mVal = 0
If lbx_Filters.List(X) <> "" And lbx_Filters.List(X) = lbx_Filters_List.List(i) Then
myVal = 1
End If
End If
If myVal = 0 Then
lbx_Filters.AddItem _
lbx_Filters_List.List(i)
End If
Next X
End If
Next i
End Sub
The error occurs the second time I try and add the same item from the first listbox and what happens is that the second for loop will loop once and on the second loop it throws an error on this line:
If Not IsError(lbx_Filters.List(X)) Then
Error being:
Could not get the list property. Invalid property array index
I eventually (with the help of the comments above) solved the issue. Thank you to all who assisted.
Private Sub btn_Add_Filter_Click()
Dim Size As Integer
Size = lbx_Filters.ListCount
Dim ListBoxContents() As String
Dim ListBoxC() As Variant
Dim i As Integer, y As Integer, X As Integer, myVal As Integer, lItem As Integer
myVal = 0
For i = 0 To lbx_Filters_List.ListCount - 1
If lbx_Filters_List.Selected(i) = True Then
If Size > 0 Then
For lItem = 0 To lbx_Filters.ListCount - 1
For X = 0 To lbx_Filters_List.ListCount - 1
If Not IsError(lbx_Filters_List.List(X)) And lbx_Filters.List(lItem) = lbx_Filters_List.List(i) Then
myVal = 1
End If
Next X
Next lItem
End If
If myVal = 0 Then
lbx_Filters.AddItem _
lbx_Filters_List.List(i)
End If
End If
Next i
End Sub
I'm building an Excel program at work so that collegues can view their upsells. What i'm stuck on is the population of the listbox.
When I populate the listbox it returns all rows. What I need it too return though is all rows where the name in the E column matches with the one contained in the public variable.
I searched all over to try and find a solution but have not had any luck.
Any help would be greatly appreciated as this is starting to bug me now.
Public Sub UserForm_Initialize()
var_associate = "Kirsty"
Dim var_nextline As Integer
var_nextline = 1
x = "a"
Do While x <> ""
x = Cells(var_nextline, 2)
If x <> var_associate Then
var_nextline = var_nextline + 1
Else
Me.lsb_upsell.AddItem(var_nextline, 2).Value
var_nextline = var_nextline + 1
End If
Loop
End Sub
x = Cells(var_nextline, 2)
should give an error, as the right-hand side returns the cell object, not the value contained in the cell, and assignment of objects must be done by using Set. Anyway, it is not what you want to have. Try
x = Cells(var_nextline, 2).Value2
Remark: You could improve your code:
Public Sub UserForm_Initialize()
Dim var_associate As String
var_associate = "Kirsty"
Dim var_nextline As Integer
var_nextline = 1
Dim x As String
Do
x = Cells(var_nextline, 2).Value2
If x = "" Then Exit Loop
If x = var_associate Then
Me.lsb_upsell.AddItem(x).Value
End If
var_nextline = var_nextline + 1
Loop
End Sub
Second remark: Where is Cells initialized (e.g. with Set Cells = ActiveSheet.Cells)? Add Option Explicit at the top of your file in order to get error messages for undeclared variables. Do you mean something like
ActiveSheet.Cells(var_nextline, 2).Value
?