i have a patient list and i have used a listbox userform in order to select multiple diagnosis codes. I am only able to apply that listbox to the first cell, a2. regardless where i click in that column, i am unable to get the diganosis codes for the next patient to fall into the next row in that diganosis column. When i make a selection, they are returning back to cell a2, regardless of where i am selecting. The code i currently have is below. Can someone please help?
Private Sub CommandButton1_Click()
myVar = ""
For x = 0 To Me.LLBXMedHist.ListCount - 1
If Me.LLBXMedHist.Selected(x) Then
If myVar = "" Then
myVar = Me.LLBXMedHist.List(x, 0)
Else
myVar = myVar & "," & Me.LLBXMedHist.List(x, 0)
End If
End If
Next x
ThisWorkbook.Sheets("Sheet1").Range("a2") = myVar
End Sub
Related
I have an Excel sheet that's a process checklist. The background is there are 3 Combo Boxes (form control) and within each Combo Box there's multiple options the user can select. Based on what the user selects as a combination between the 3 Combo Boxes it will hide/unhide specific rows in a section and their corresponding checkboxes. I'm trying to code this in VBA.
Between setting everything up these are the problems I'm running into with VBA:
There are 60 different ways the user can select options between the 3 Combo Boxes. Including the "Select Option" options (which will be used), the first ComboBox has 5 options, the second 4 options, and the last 3 options. The obvious I've been trying is If/Else logic, but copying and pasting 60 times over seems very redundant and leaves the sheet prone to coding errors that will take time to fix. Is there a better way to code this? Or in the way I'm trying to do this for each change, the If/Else logic is the best way?
When coding (I've pasted a short example of part of my code below this section with a few of the cases), I run into "Method and data member not found" or "Invalid use of Me" errors when debugging. How do I fix this?
How do I hide and unhide the checkboxes along with the rows be hid and unhidden so the formatting doesn't change and there are not stray checkboxes everywhere?
Sub ComboBox1_Change()
'Combo Box 1 is Asset Type, Combo Box 2 is AUS, Combo Box 3 is Transaction Type
'Select, Select, Select OR Refinance
If Me.ComboBox1.Value = "Select Asset Type" And Me.ComboBox2.Value = "Select AUS" And Me.ComboBox3.Value = "Select Transaction Type" Or Me.ComboBox3.Value = "Refinance" Then
Worksheets("Assets Checklist").Rows("19:37" And "39").EntireRow.Hidden = True
'Select, Select, Purchase
ElseIf Me.ComboBox1.Value = "Select Asset Type" And Me.ComboBox2.Value = "Select AUS" And Me.ComboBox3.Value = "Purchase" Then
Worksheets("Assets Checklist").Rows("39").EntireRow.Hidden = False
Worksheets("Assets Checklist").Rows("19:37").EntireRow.Hidden = True
'Liquid, Select, Select
ElseIf Me.ComboBox1.Value = "Liquid" And Me.ComboBox2.Value = "Select AUS" And Me.ComboBox3.Value = "Select Transaction Type" Then
Worksheets("Assets Checklist").Rows("31:34").EntireRow.Hidden = False
Worksheets("Assets Checklist").Rows("19:30" And "35:37" And "39").EntireRow.Hidden = True
And the above code continues for each case.
If you have 60 distinct cases then the most maintainable method might be to use a worksheet with columns for CB1/2/3 values and a column to hold visible and hidden rows (as range address like "A1:A10,A12"). Create a method which reads the values and looks up the matching row on the sheet, then sets the row visibility accordingly.
'this is called from each of the 3 combos
Sub ShowHideRows()
Dim cb1, cb2, cb3, arr, r As Long, rngHide As String, rngShow As String
cb1 = comboValue("combo1")
cb2 = comboValue("combo2")
cb3 = comboValue("combo3")
Debug.Print cb1, cb2, cb3
arr = Me.Range("choices").Value 'lookup table is a named range
'better on a different sheet....
For r = 1 To UBound(arr, 1)
If arr(r, 1) = cb1 Then
If arr(r, 2) = cb2 Then
If arr(r, 3) = cb3 Then
rngShow = arr(r, 4)
rngHide = arr(r, 5)
Exit For 'stop checking
End If
End If
End If
Next r
If rngHide <> "" Then Me.Range(rngHide).EntireRow.Hidden = True
If rngShow <> "" Then Me.Range(rngShow).EntireRow.Hidden = False
End Sub
'read a Forms combo control value
Function comboValue(cbName As String)
With Me.Shapes(cbName)
comboValue = .ControlFormat.List(.ControlFormat.ListIndex)
End With
End Function
Setup:
'Each of the three Combo Boxes have al Linked Cell
'In an another cell concatenate the numeric values of the three Linced Cells
'e.g. in cell A1 have this: =A2 & A3 & A4
'where A2, A3, and A4 are the Linked cells of CBox1, CBox2 and CBox3
'In every ComboBox value change, call the Sub
'SixtyCases with parameter the value of cell A1
Private Sub SixtyCases(combination As String)
Select Case combination
Case "111" 'first combination
'YOUR CODE HERE
Case "112", "132" ' OR
'YOUR CODE HERE
Case "113"
'YOUR CODE HERE
'...
'...
Case "543" 'last combination
'YOUR CODE HERE
End Select
End Sub
I will admit to being a terrible at code, and have always struggled with Macros... forgive my ignorance.
What I am working on building is a part number index that will create a new sequential number within a numerical series after a macro-button is pressed.
I'd like each button to scan between a range [i.e. 11-0000 (MIN) and 11-9999 (MAX)] and select the max value cell that exists. At that selection point insert an entire new row below with the next + 1 sequential number in the "B" column.
I have my button creating the table row as I would like, however I need help in defining the ".select(=Max(B:B))" and as I understand Max will also limit the # of line items it queries?
I have also been playing with .Range("B" & Rows.CountLarge) with little to no success.
Ideally the 11-**** button [as seen in the screen cap] should insert a sequential number below the highlighted row.
Maybe I'm way over my head, but any guidance even in approach or fundamental structure of the code would help be greatly appreciated!
Private Sub CommandButton1_Click()
Sheets("ENGINEERING-PART NUMBERS").Range("B" & Rows.CountLarge).End(xlUp).Select
ActiveCell.Offset(1, 0).Select
ActiveCell.EntireRow.Insert Shift:=xlDown
ActiveCell.Value = "=ActiveCell + 1"
End Sub
Screen Cap of Spread Sheet
Perhaps there is a simpler solution that I've overlooked, but the below will work.
Insert a module into your workbook and add this code:
Public Sub AddNextPartNumber(ByVal FirstCellInColumn As Range, Optional ByVal PartMask As Variant = "")
Dim Temp As Variant, x As Long, MaxValueFound(1 To 2) As Variant
'Some error checking
If PartMask = "" Then
MsgBox "No part mask supplied", vbCritical
Exit Sub
ElseIf Not PartMask Like "*[#]" Then
MsgBox "Invalid part mask supplied; must end in ""#"".", vbCritical
Exit Sub
ElseIf PartMask Like "*[#]*[!#]*[#]" Then
MsgBox "Invalid part mask supplied; ""#"" must be continuous only.", vbCritical
Exit Sub
End If
'Get the column of data into an array
With FirstCellInColumn.Parent
Temp = .Range(FirstCellInColumn, .Cells(.Rows.Count, FirstCellInColumn.Column).End(xlUp))
End With
'Search through the array and find the largest matching value
For x = 1 To UBound(Temp, 1)
If Temp(x, 1) Like PartMask Then
If MaxValueFound(1) < Temp(x, 1) Then
MaxValueFound(1) = Temp(x, 1)
MaxValueFound(2) = x
End If
End If
Next x
'Output new part number
If MaxValueFound(2) = 0 Then
'This part mask doesn't exist, enter one with 0's at the end of the list
With FirstCellInColumn.Offset(x - 1, 0)
.Value = Replace(PartMask, "#", 0)
.Select
End With
Else
'Get the length of the number to output
Dim NumberMask As String, NumFormatLength As Long
NumFormatLength = Len(PartMask) - Len(Replace(PartMask, "#", ""))
NumberMask = String(NumFormatLength, "#")
'Determine the new part number
MaxValueFound(1) = Replace(MaxValueFound(1), Replace(PartMask, NumberMask, ""), "")
MaxValueFound(1) = Replace(PartMask, NumberMask, "") & Format((MaxValueFound(1) * 1) + 1, String(NumFormatLength, "0"))
'Insert row, add new part number and select new cell
FirstCellInColumn.Offset(MaxValueFound(2), 0).EntireRow.Insert
With FirstCellInColumn.Offset(MaxValueFound(2), 0)
.Value = MaxValueFound(1)
.Select
End With
End If
End Sub
Then, for each button, you write the code like this:
Private Sub CommandButton1_Click()
'this is the code for the [ADD 11-****] button
AddNextPartNumber Me.Range("B16"), "11-####"
End Sub
Private Sub CommandButton2_Click()
'this is the code for the [ADD 22-****] button
AddNextPartNumber Me.Range("B16"), "22-####"
End Sub
This has been written assuming that inserting a new row onto your sheet won't affect other data and that adding new data to the bottom of the table without inserting a row also won't affect other data.
Assuming you're working with a table, by default it should auto-resize to include new data added to the last row.
Good luck learning the ropes. Hopefully my comments help you understand how what I wrote works.
I'm working on a loop that finds the adjacent value based on a looped additem list combobox in userform. First looped code works just perfect. second doesnt find its value.
I've tried changing formatting in the cell where the value is stored. i've tried to switch the userform box with the working one. That makes them both malfunction.
'Works without a problem
Private Sub REQUESTED_Change()
i = 1
kto = FORM.REQUESTED
Do While (Worksheets("DATA").Cells(i, 1) <> "")
i = i + 1
If Worksheets("DATA").Cells(i, 1) = kto Then
DEPARTEMENT.Text = Worksheets("DATA").Cells(i, 2)
End If
Loop
End Sub
'Doesn't work. It loops with the correct value, but doesnt find itself
Private Sub CUSTNR_Change()
i4 = 1
kSto = FORM.CUSTNR
Do While (Worksheets("DATA").Cells(i4, 6) <> "")
i4 = i4 + 1
If Worksheets("DATA").Cells(i4, 6) = kSto Then
NAZWA.Text = Worksheets("DATA").Cells(i4, 7)
End If
Loop
End Sub
It should loop based on the value typed/listed in the userform combobox, find the row its in, and based on that i value, get the adjacent value in the cell next to it in the same row.
I have 80 rows where the user can enter a predetermined value under column Ward. This unhides a button next to it. Upon clicking it, it empties the adjacent value and increments (+1) a particular cell in another sheet depending on the original value.
Currently, I have 80 ActiveX buttons next to the Ward cells that hides/unhides depending on the value of the Ward cells. I've noticed that adding more buttons slows down the spreadsheet because of the sheer volume of If Then statements I have.
If Range("F8").Value = 0 Then
Sheets("Admissions").EDAdmit1.Visible = False
Else
Sheets("Admissions").EDAdmit1.Visible = True
End If
If Range("L8").Value = 0 Then
Sheets("Admissions").ElecAdmit1.Visible = False
Else
Sheets("Admissions").ElecAdmit1.Visible = True
End If
If Range("F9").Value = 0 Then
Sheets("Admissions").EDAdmit2.Visible = False
Else
Sheets("Admissions").EDAdmit2.Visible = True
End If
If Range("L9").Value = 0 Then
Sheets("Admissions").ElecAdmit2.Visible = False
Else
Sheets("Admissions").ElecAdmit2.Visible = True
End If
.. and so on.
Not to mention the If Then statements I have for every button click.
Private Sub EDAdmit1_Click()
If Range("F8") = "ICU" Then
Worksheets("Overview").Range("AD11").Value = Worksheets("Overview").Range("AD11") + 1
ElseIf Range("F8") = "HDU" Then
Worksheets("Overview").Range("AF11").Value = Worksheets("Overview").Range("AF11") + 1
ElseIf Range("F8") = "DPU" Or Range("F8") = "Other" Then
Else
Col = WorksheetFunction.VLookup(Range("F8"), Range("U1:V27"), 2)
Worksheets("Overview").Range(Col).Value = Worksheets("Overview").Range(Col).Value + 1
End If
Range("F8").ClearContents
End Sub
Is there a more efficient way of doing this?
Admission List:
You could consider using "admit" hyperlinks in the cells next to the Ward selections: that way you only need one handler (Worksheet_FollowHyperlink in the worksheet module). Note you need to use Insert >> Hyperlink and not the HYPERLINK() formula-type links here (because formula-based links don't trigger the FollowHyperlink event).
You can ditch the hide/show code and instead use conditional formatting to change the link font color to hide the links when there's no Ward selected. If a user clicks on one of the hidden links then you can just do nothing.
Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
Dim rngSrc As Range, addr, ward
Set rngSrc = Target.Range '<< the cell with the link
ward = rngSrc.Offset(0, 1).Value '<< cell with Ward
'only do anything if a ward is selected
If Len(ward) > 0 Then
'find the cell to update
Select Case ward
Case "ICU"
addr = "AD11"
Case "HDU"
addr = "AF11"
Case "DPU", "Other"
addr = ""
Case Else
addr = Application.VLookup(ward, Me.Range("U1:V27"), 2, False)
End Select
'if we have a cell to update then
If Len(addr) > 0 Then
With Worksheets("Overview").Range(addr)
.Value = .Value + 1
End With
End If
rngSrc.Offset(0, 1).ClearContents
End If
rngSrc.Select '<< select the clicked-on link cell
' (in case the link points elsewhere)
End Sub
At the beginning of your code put this line:
Application.ScreenUpdating = False
this will disable all screen updates. Let your code do changes, and then enable screen updating, and all your changes will appear.
Application.ScreenUpdating = True
Disabling screen updating usually makes the execution of code faster.
I have a listbox named ListBox1 on Sheet1 of an Excel workbook.
Every time the user selects one of the items in the list, I need to copy its name to a variable named strLB.
So, if I have Value1, Value2, Value3, Value4 and the user selects Value1 and Value3, I need my strLB to come out as Value1,Value3.
I tried doing that post hoc with:
For i = 1 To ActiveSheet.ListBoxes("ListBox1").ListCount
If ActiveSheet.ListBoxes("ListBox1").Selected(i) Then strLB = strLB & etc.etc.
Next i
But this is very slow (I have 15k values in my listbox). This is why I need to record the selection in real time and not in a cycle, after the user is done inputting.
I'm going to also need a way to check if the user removed any of the previous selection.
Unfortunately for MSForms list box looping through the list items and checking their Selected property is the only way. However, here is an alternative. I am storing/removing the selected item in a variable, you can do this in some remote cell and keep track of it :)
Dim StrSelection As String
Private Sub ListBox1_Change()
If ListBox1.Selected(ListBox1.ListIndex) Then
If StrSelection = "" Then
StrSelection = ListBox1.List(ListBox1.ListIndex)
Else
StrSelection = StrSelection & "," & ListBox1.List(ListBox1.ListIndex)
End If
Else
StrSelection = Replace(StrSelection, "," & ListBox1.List(ListBox1.ListIndex), "")
End If
End Sub
The accepted answer doesn't cut it because if a user de-selects a row the list is not updated accordingly.
Here is what I suggest instead:
Private Sub CommandButton2_Click()
Dim lItem As Long
For lItem = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(lItem) = True Then
MsgBox(ListBox1.List(lItem))
End If
Next
End Sub
Courtesy of http://www.ozgrid.com/VBA/multi-select-listbox.htm
To get the value of the selected item of a listbox then use the following.
For Single Column ListBox:
ListBox1.List(ListBox1.ListIndex)
For Multi Column ListBox:
ListBox1.Column(column_number, ListBox1.ListIndex)
This avoids looping and is extremely more efficient.
Take selected value:
worksheet name = ordls
form control list box name = DEPDB1
selectvalue = ordls.Shapes("DEPDB1").ControlFormat.List(ordls.Shapes("DEPDB1").ControlFormat.Value)