When I select a value in ComboBox1, ComboBox2 is automatically filled with data from a specified range. On selecting a value in ComboBox2 a corresponding value will be placed in a TextBox.
It appears that when I have only numbers in the ComboBox value the code will not function.
If the value consists of letters or numbers AND letters everything works just fine.
I tried different formatting of the cells in the range, but no success. Finding an answer on internet is problematic as I don't know the keywords for searching.
Here's my code so far:
Private Sub ComboBox1_Change()
Dim index1 As Integer
Dim cLoc1 As Range
Dim index2 As Integer
Dim cLoc2 As Range
Dim ws As Worksheet
Set ws = Worksheets("Formlists")
index1 = ComboBox1.ListIndex
'index2 = ComboBox2.ListIndex
ComboBox2.Clear
ComboBox3.Clear
Select Case index1
Case Is = 0
With ComboBox2
For Each cLoc1 In ws.Range("Codelist1")
With Me.ComboBox2
.AddItem cLoc1.Value
End With
Next cLoc1
End With
Case Is = 1
With ComboBox2
For Each cLoc1 In ws.Range("Codelist2")
With Me.ComboBox2
.AddItem cLoc1.Value
End With
Next cLoc1
End With
End Select
End Sub
Private Sub combobox2_change()
Dim index2 As Integer
Dim ws As Worksheet
Set ws = Worksheets("Formlists")
index2 = ComboBox1.ListIndex
Select Case index2
Case Is = 0
With TextBox4
For i = 1 To 10
If ws.Cells(i + 1, Columns(90).Column).Value = ComboBox2.Value Then
TextBox4.Value = ws.Cells(i + 1, Columns(91).Column).Value
Else
'do nothing
End If
Next i
End With
Case Is = 1
With TextBox4
For i = 1 To 10
If ws.Cells(i + 1, Columns(92).Column).Value = ComboBox2.Value Then
TextBox4.Value = ws.Cells(i + 1, Columns(93).Column).Value
Else
'do nothing
End If
Next i
End With
End Select
End Sub
Is there a way to let the code/ComboBox accept any inputformat?
Thanks in advance
Rob
It appears you just need to coerce the values to strings in the code:
If CStr(ws.Cells(i + 1, 90).Value) = ComboBox2.Value Then
and similarly with the other test. Note there isn't any point in using Columns(90).Column rather than just 90. ;)
Related
I am facing a problem in getting the sequence of the unique numbers(Serial number) when the userform is closed and opened later on. Firstly, when I fill the data in the userform everything is captured in the excel sheet perfectly with correct sequence; if I close the userform and run the code by filling the userform with new data the unique ID's are again starting from "1" but not according to the excel sheet row number which was previously saved.
Below is the code I tried:
Private Sub cmdSubmit_Click()
Dim WB As Workbook
Dim lr As Long
Set WB = Workbooks.Open("C:\Users\Desktop\Book2.xlsx")
Dim Database As Worksheet
Set Database = WB.Worksheets("Sheet1")
eRow = Database.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
lr = Database.Range("a65536").End(xlUp).Row
With Sheets("Sheet1")
If IsEmpty(.Range("A1")) Then
.Range("A1").Value = 0
Else
Database.Cells(lr + 1, 1) = Val(Database.Cells(lr, 1)) + 1
End If
End With
Database.Cells(eRow, 4).Value = cmbls.Text
Database.Cells(eRow, 2).Value = txtProject.Text
Database.Cells(eRow, 3).Value = txtEovia.Text
Database.Cells(eRow, 1).Value = txtUid.Text
Call UserForm_Initialize
WB.SaveAs ("C:\Users\Desktop\Book2.xlsx")
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim maxNumber
If Not Intersect(Target, Range("B:B")) Is Nothing Then
' don't run when more than one row is changed
If Target.Rows.Count > 1 Then Exit Sub
' if column A in the current row has a value, don't run
If Cells(Target.Row, 1) > 0 Then Exit Sub
' get the highest number in column A, then add 1 and write to the
' current row, column A
maxNumber = Application.WorksheetFunction.Max(Range("A:A"))
Target.Offset(0, -1) = maxNumber + 1
End If
End Sub
Private Sub UserForm_Initialize()
With txtUid
.Value = Format(Val(Cells(Rows.Count, 1).End(xlUp)) + 1, "0000")
.Enabled = False
End With
With txtProject
.Value = ""
.SetFocus
End With
End Sub
In this image if you see unique id's are repeating 1 and 2, but I need as 1,2,3,4....
I think this is where the issue is coming from. You need to re-calculate the last row every time the user form is Initialized.
Private Sub UserForm_Initialize()
Dim ws as Worksheet: Set ws = Thisworkbook.Sheets("Database")
With txtUid
.Value = Format(ws.Range("A" & ws.Rows.Count).End(xlUp) + 1, "0000")
.Enabled = False
End With
With txtProject
.Value = ""
.SetFocus
End With
End Sub
It's always risky to use row numbers or [max range value +1] as a sequence number.
Safer to use something like a name scoped to the worksheet, which has a value you can increment. Then the sequence is independent of your data.
E.g.
Function GetNextSequence(sht As Worksheet) As Long
Const SEQ_NAME As String = "SEQ"
Dim nm As Name, rv As Long
On Error Resume Next
Set nm = sht.Names(SEQ_NAME)
On Error GoTo 0
'add the name if it doesn't exist
If nm Is Nothing Then
Set nm = sht.Names.Add(Name:=SEQ_NAME, RefersToR1C1:="=0")
End If
rv = Evaluate(nm.Value) + 1
nm.Value = rv
GetNextSequence = rv
End Function
I have a worksheet with 6 activex comboboxes.
Combobox1 has 21 choiches.
Combobox2 is dependent on Combobox1, number of choices vary.
Combobox3 has 2 choices.
Combbox4 is dependent on Combobox3 and has 21 choices.
Combobox5 has 21 choiches.
Combobox6 is dependent on Combobox5, number of choices vary.
I would like to loop through combobox1 - value1 and combobox2 - value1.
Then I would like to loop through combobox3 - value 1 and combobox4 - value1.
I would like to loop through combobox5 - value1 and combobox6 - value1.
I am using vlookup to based on the linked cells of the different comboboxes. The code I have at the moment only loops through the cell values of combobox1 and combobox2. I would like to physically change the value in the combobox, from value1 to lastvalue.
Which would be Combobox1 - value1, combobox2 value1 to last value, combobox3 first value, combobox4 - value1, combobox 5, value1 and finally combobox6 - value1 to last value.
Sub Demo()
Dim Ws As Worksheet
Dim shp As Shape
Dim cb As ComboBox
Set Ws = ActiveSheet
For Each shp In Ws.Shapes
With shp
Select Case .Type
Case msoFormControl
If .FormControlType = xlDropDown Then
If .ControlFormat.Value = 0 Then
MsgBox .Name & " = "
Else
MsgBox .Name & " = " & .ControlFormat.List(.ControlFormat.Value)
End If
End If
Case msoOLEControlObject
If .OLEFormat.progID = "Forms.ComboBox.1" Then
Set cb = .OLEFormat.Object.Object
MsgBox cb.Name & " = " & cb.Value
End If
End Select
End With
Next
End Sub
The code above gives me the values of my 6 activex comboboxes.
Sub try()
Dim Ws As Worksheet
Set Ws = Worksheets("Sheet1")
Count = 0
For Each OleObj In Ws.OLEObjects
If OleObj.OLEType = xlOLEControl Then
If TypeName(OleObj.Object) = "ComboBox" Then
Count = Count + 1
End If
End If
Next OleObj
MsgBox "Number of ComboBoxes :" & Count
End Sub
This code counts the amount of comboboxes in a sheet! Maybe it can be adapted to increment each combobox?
I am thinking about something like this:
Sub Test()
Select Case Me.Form
Case "Stockholms län"
Me.Kommun1.RowSource = "Stockholms_län"
' Code for each loop where combobox1 is "Stockholm län" and Combobox2
' is a named range.
Case "Skåne län"
Me.Kommun1.RowSource = "Skåne_län"
' Code for each loop where combobox1 is "Skåne län" and Combobox2 is
' a named range.
End Select
End sub
I can manually set the values of combobox1 and combobox2.
Sub WantToLoop()
Dim län1 As String
Dim kommun1 As String
Dim län2 As String
Dim kommun2 As String
ThisWorkbook.Sheets("Test").län1 = "Skåne län"
ThisWorkbook.Sheets("Test").kommun1 = "Bjuv"
End Sub
The code above kind of works but I can't do select cases for several hundred of choices. How can I loop this?
I am getting closer but now I am setting the value of the combobox. I want to access the value of the combobox.
Sub try()
Dim i As Integer
Dim j As Integer
For i = 1 To 2
Sheets("Test").Shapes("Län" & i).OLEFormat.Object.Object = "item" & i
Sheets("Test").Shapes("Kommun" & i).OLEFormat.Object.Object = "item" & i
Next
End sub
Sub IterateComboBox()
Dim i As Long
With Sheets("Jämföra").Län1
For i = 0 To .ListCount - 1
'Debug.Print .List(i)
.Value = .List(i)
Next
End With
End Sub
This code does what I want. How can I turn this into a select case?
Sub Try2()
Dim k As Integer
Dim l As Integer
Dim m As Integer
Dim n As Integer
Sheets("Test").Län1.ListIndex = 0
For l = 0 To 25
Sheets("Test").Kommun1.ListIndex = l
Sheets("Test").Län2.ListIndex = 0
For n = 0 To 25
Sheets("Test").Kommun2.ListIndex = n
Application.ScreenUpdating = True
Sheets("Score").Select
Dim LR As Long
LR = Cells(Rows.Count, 1).End(xlUp).Row + 1
'Län1, Kommun1 OK
Cells(LR, "A").Value = Sheets("Test").Range("G5").Value
Cells(LR, "B").Value = Sheets("Test").Range("G6").Value
Next
Next
End Sub
This code loops through combobox1 value1, combobox2 all values, combobox3 value1 and combobox4 all values. How can I turn this into a case?
Or how do I turn this into a function where I can pass the values of Län1, Kommun1, Län2 and Kommun2 into the function??
I am using a Listbox which contains the name of folders. I need to select the names from listbox (one at a time, to maintain the order of selection) and add it to the excel column A1, such that each time adding to the next empty cell of column A. I am very new to vb and need help. Below are the approaches i tried.
Approach 1)
Sub AddRecord_Click()
With Sheet1.ListBox1
For intIndex = 0 To .ListCount - 1
With ActiveSheet
LastRow = .Cells(.Rows.Count, "F").End(xlUp).Row
End With
If .Selected(intIndex) Then
Sheet1.Cells(LastRow, "A") = Sheet1.ListBox1.Value
NextRow = LastRow + 1
End If
Next
End With
End Sub
Approach 2)
Sub AddRecord_Click()
intRecord = (CInt(Range("A1").End(xlDown).Row) + 1)
Sheet1.Cells(intRecord, "A") = Sheet1.ListBox1.Value
intRecord = intRecord + 1
End Sub
Try this may be helpful to u
Sub ListBox7_Change()
Dim i As Long
With ActiveSheet.ListBoxes("List Box 7")
For i = 1 To .ListCount
If .Selected(i) Then
Range("A" & Rows.count).End(xlUp).offset(1).Value = .List(i)
End If
Next i
End With
End Sub
First you get last used row from the excel sheet and finally increment that last row and insert next column value to the excel.
Dim last as Excel.Range = xlWorkSheet.Cells.SpecialCells
(Excel.XlCellType.xlcellTypeLastCell,Type.Missing)
dim lastUsedRow As Integer = last.Row
lastUsedRow += 1
xlWorksheet.RangeA("A"+ lastUserRow).value = ListBox1.Value
Private Sub CommandButton22_Click()
row_number = 6
Do
DoEvents
row_number = row_number + 1
item_description = ActiveSheet.Range("B" & row_number)
If InStr(item_description, "Direct Credit") > 0 Then
item_description = ActiveCell.Activate
ActiveCell.Value = Right(ActiveCell, Len(ActiveCell) - 21)
End If
Loop Until item_description = B1000
End Sub
Hi,
I need to trim first 21 characters if the specific cell starts with "Direct Credit"?
There is something wrong in my coding after "Then" in If...
Can Some one help please?
See if this helps. If so please mark the answer as answered.
Public Sub MyTrim()
Const STARTS_WITH_STR As String = "Direct Credit"
Const TRIM_NUM As Integer = 21
Dim sht As Worksheet
Dim range As range
Dim cell As range
Dim sText As String
Dim iPos As Integer
Dim i As Integer
Set sht = ActiveSheet
' loop for 1000 rows
For i = 1 To 1000
' for each row, get the cell in column "B"
Set cell = sht.Cells(i, "B")
' get the text of the cell with triming blanks on both side of the string
sText = Trim(cell.Text)
' Search for a sub string. It does a text based compare (vbTextCompare)
' meaning- it will look for "Direct Credit" and also for "DIRECT CREDIT" and
' every thing in between (for example: DIREct Credit, .....)
iPost = InStr(1, sText, STARTS_WITH_STR, vbTextCompare)
' if the cell starts with the sub string above
If (iPos = 1) Then
' remove the 21 first chars
sText = Mid(sText, TRIM_NUM + 1)
cell.Value = sText
End If
Next
End Sub
Private Sub CommandButton23_Click()
Dim c As Range
For Each c In Range("B6:B1200")
With c
If Left(.Value, 13) = "Direct Credit" Then .Value = Right(.Value, Len(.Value) - 21)
End With
Next c
End Sub
hope u're well. Need an expert help after trying a lot without sucess, please.
I have a price list in Sheet1 with 3 columns:
Medical Procedure
Type
Value of Procedure
In a userform, I need to return in Textbox1 the value of the procedure based on the criteria selected in combobox1 (with values that can be found in Medical Procedure column in Sheet1) and the caption in label1 (wich alrealdy is populated with a value that can be encounter in the Type column in Sheet1).
I tried this found here in stackoverflow from the user B Hart (thanks, B Hart!), but I wasn't able to change it to return in a textbox as a numerical value (this vba insert the found value in a listbox instead). Another issue is that the criteria below is in two combobox. I need the two criterias to be in a combobox and another in a label.
Private Sub GetCondStrandValue()
Dim iRow As Long
Dim strValue As String
strValue = vbNullString
If Me.ComboBox1.Value = vbNullString Or Me.ComboBox2.Value = vbNullString Then Exit Sub
With Planilha1
For iRow = 2 To .Range("A65536").End(xlUp).Row
If StrComp(.Cells(iRow, 1).Value, Me.ComboBox1.Value, 1) = 0 And _
StrComp(.Cells(iRow, 2).Value, Me.ComboBox2.Value, 1) = 0 Then
strValue = .Cells(iRow, 3).Value
Exit For
End If
Next
End With
If strValue = vbNullString Then Exit Sub
With Me.ListBox1
'If you only want a single value in the listbox un-comment the .clear line
'Otherwise, values will continue to be added
'.Clear
.AddItem strValue
.Value = strValue
.SetFocus
End With
End Sub
Maybe something like this:
Private Sub combobox1_Change()
Dim lastRow As Integer
lastRow = Cells(Rows.Count, 1).End(xlUp).Row
With Me
For r = 2 To lastRow
If Sheets("Sheet1").Cells(r, 1) = .ComboBox1.Value And Sheets("Sheet1").Cells(r, 2) = .Label1.Caption Then
.TextBox1.Text = Sheets("Sheet1").Cells(r, 3)
Exit For
End If
Next
End With
End Sub