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
Related
I've created several tables in the same sheet, each table assigning it to a month, plus there are two icons (two shapes) to navigate to the next or previous month. What I need is to cycle through the months using the two icons (next/previous month). For example, if the user needs January, the columns (B:AD) will be shown and the reset will be hidden, so on with the other months.
Columns to be shown:
January (B:AD)
February(AF:BH)
March(BJ:CL)
April(CN:DP)
May(DR:ET)
June(EV:FX)
July(FZ:HB)
August(HD:IF)
September(IH:JJ)
October(JL:KN)
November(KP:LR)
December(LT:MV)
Here is the link to my excel:
https://1drv.ms/x/s!Av2jQlwHZCT3gjeo3q_Po99tvoSr?e=vICkeT
Try this code:
Sub go_right() 'assign to the right triangle
ShiftMonth 1
End Sub
Sub go_left() 'assign to the left triangle
ShiftMonth -1
End Sub
Sub ShiftMonth(direction As Integer)
Const PERIOD = 30 'the number of columns for each month
Const TEXT_BOX_NAME = "TextBox 1" 'your textbox (with month) name
With ThisWorkbook.Worksheets("MER Monthly Tracker")
cur = Val(.Range("A1").ID) '.Range("A1").ID uses to store the current month number (0..11)
cur = Evaluate("MOD(" & cur + direction & "," & 12 & ")") ' get the target month number according to direction
.Range("A1").ID = cur 'store the new month number
Application.ScreenUpdating = False
.Columns(2).Resize(, 12 * PERIOD).Hidden = True 'hide all columns
.Columns(2 + cur * PERIOD).Resize(, PERIOD).Hidden = False 'show columns with target month
.Shapes(TEXT_BOX_NAME).TextFrame2.TextRange.Text = .Cells(3, 2 + cur * PERIOD + 2) ' set the name of month
Application.ScreenUpdating = True
End With
End Sub
Note that triangles and TextBox should have the "Do not move or resize with cells" property, so that these shapes will not be hidden
when hiding columns
Please, try the next way:
Your shape moving left should be named "Isosceles Triangle 1", the one moving right "Isosceles Triangle 2", as they are. The rectangle should be named "MonthsRect"! Of course, you must choose the "Do not move or resize with cells" shapes property. Right click -> Size and properties -> Properties (from 'Size & properties' part...).
Please, copy the next code in a standard module:
Option Explicit
Dim sh As Worksheet, arrMonths, shMnth As Shape
Private Const strMonths = "January,February,March,April,May,June,July,August,September,Octomber,November,December"
Private Const strCols = "B:AD,AF:BH,BJ:CL,CN:DP,DR:ET,EV:FX,FZ:HB,HD:IF,IH:JJ,JL:KN,KP:LR,LT:MV"
Sub PreviousMonth()
MoveMonths "prev"
End Sub
Sub NextMonth()
MoveMonths "next"
End Sub
Function MoveMonths(dir As String)
Dim existM As String, NextM As String, mtch, arrCol
existM = actualMonths
mtch = Application.match(existM, arrMonths, 0)
If mtch = 1 And dir = "prev" Then
NextM = "December"
ElseIf mtch = 12 And dir = "next" Then
NextM = "January"
Else
NextM = Application.Index(arrMonths, mtch + IIf(dir = "prev", -1, 1))
End If
shMnth.TextFrame2.TextRange.Text = NextM & ", 2021"
'hide columns:
sh.Range("A1:MV1").EntireColumn.Hidden = True
mtch = Application.match(NextM, arrMonths, 0)
arrCol = Split(strCols, ",")
sh.Range(arrCol(mtch - 1)).EntireColumn.Hidden = False
Application.Goto sh.Range("A1")
End Function
Function actualMonths() As String
Dim actMonth As String
If Not IsArray(arrMonths) Then
arrMonths = Split(strMonths, ",")
End If
If sh Is Nothing Then Set sh = ActiveSheet
If shMnth Is Nothing Then Set shMnth = sh.Shapes("MonthsRect")
actualMonths = Split(shMnth.TextFrame2.TextRange.Text, ",")(0)
End Function
Please, assign the two above (eloquently named). "PreviousMonth" to the left one and "NextMonth" to the right triangle. You can do it right clicking on the shape, choose Assign Macro..., choose 'This workbook' at 'Macros in:', click on the appropriate Sub and press 'OK.
You did not answer my clarification question regarding what to be happening when the active month is "January" and press left triangle, or "December" and press the right one. The above code will jump to "December" for the first case and to "January" in the second one. Theoretically, you could decrease the year and bring data from another sheet...
Please, play with the two triangles and send some feedback
I have a drop down button and macro assigned to it. Upon selection of option from drop down the macro asks user whether he/she wants to make the change. If user selects yes code runs successfully. If user selects no the code ends. But the drop down selection changes to the new value which user selected. I want to reflect the old selection before user opted not to effect the change.
Here is how it works.
Step 1 - Proposal Origin is NA
Step 2 - User changes it to LA. But in the confirmation window opts "No".
Step 3 - Since in step 2 user selected "No" nothing happened. But the selection shows Proposal Origin as LA.
I want to keep it as NA when user selects "No" in conformation window.
Here is the code I have
Sub Dropdown6_BeiÄnderung()
'Dropbox Location
Dim Update As Integer
DropVal = Range("L18").Value
Update = MsgBox("You have selected " & Cells(18, 12) & " as Proposal Location. This will reset the Labor sheets. Do you want to continue?", vbYesNo, vbDefaultButton1)
If Update = vbYes Then
Worksheets("NA-Hours").Range("C8").Value = 0
Worksheets("LA-Hours").Range("C8").Value = 0
Worksheets("EU-Hours").Range("C8").Value = 0
Worksheets("MEA-Hours").Range("C8").Value = 0
Worksheets("AP-Hours").Range("C8").Value = 0
For i = 17 To 21
SName = Cells(i, 16).Value
If Cells(i, 17).Value = 1 Then
Worksheets(SName).Visible = True
Else: Worksheets(SName).Visible = False
End If
Next
Else
me.Drop Down 6.text = DropVal
End If
End Sub
Need help on the else part to reflect the earlier selection which is stored in variable DropVal.
Please, look at the next code example in order to understand how a Drop Down object value can be handled:
Sub handleDropDown()
Dim dd As DropDown, rngDL As Range, DropVal As String
Set dd = ActiveSheet.DropDowns("Drop Down 6")
Set rngDL = ActiveSheet.Range(dd.ListFillRange)
DropVal = "Test" 'use here what you need
Debug.Print dd.value 'it returns the index of the selected item in ListFillRange range
Debug.Print rngDL(dd.value) 'it returns the drop down value
rngDL.cells(dd.value) = DropVal 'it set/change the drop down value, but changing the cell in the range
End Sub
What I tried showing is to change the drop down object value. I must confess I am not sure that I understand what "to reverse the drop down selection" should mean...
The drop down value can be changed only if DropVal is part of the drop down ListFillRange and it was the previous selection. In such a case, the next approach should work.
Practically, you should implement the next code inside your Else part of the code:
Dim dd As DropDown, rngDL As Range, mtch As Long
Set dd = ActiveSheet.DropDowns("Drop Down 6")
Set rngDL = ActiveSheet.Range(dd.ListFillRange)
'If Range("L18").Value = "NA" the drop down value will become "NA"
mtch = Application.match(DropVal, rngDL, 0)' position/index of DropVal
If Not IsError(mtch) Then
dd.value = mtch
Else
MsgBox DropVal & " could not be found in " & rngDL.Address
End If
I already have a barcode scanner VBA function, that recognizes the barcode number, but the problem I have is that I have to click enter every time, is there any way to do it automatically and store the count in a certain column? Currently it works if I enter the same value stored in column B, it will count the records in column C, but I want to avoid hitting enter every time
This is what I got so far
Private Sub btnAdd_Click()
Dim TargetCell As Range
If WorksheetFunction.CountIf(Sheets("Sheet1").Columns(2), TextBox1.Value) = 1 Then
Set TargetCell = Sheets("Sheet1").Columns(2).Find(TextBox1.Value, , xlValues, xlWhole).Offset(0, 1)
TargetCell.Value = TargetCell.Value + 1
Else
MsgBox "Code not found"
End If
Me.Hide
End Sub
It's hard to say what you have. For example, who presses the button? Or, does your scanner enter a return. I think the code below should work under any circumstances. Please try it.
Private Sub TextBox1_Change()
Dim TargetCell As Range
Dim Qty As Long
With TextBox1
If Len(.Value) = 3 Then
Set TargetCell = Worksheets("Sheet1").Columns(2) _
.Find(.Value, , xlValues, xlWhole)
If TargetCell Is Nothing Then
MsgBox """" & .Value & """ Code not found"
Else
With TargetCell.Offset(0, 1)
Qty = .Value + 1
.Value = Qty
End With
Application.EnableEvents = False
TextBox1.Value = "Count = " & Qty
Application.EnableEvents = True
End If
.SelStart = 0
.SelLength = Len(.Value)
End If
End With
End Sub
I think you have a user form and in this form you have a text box called TextBox1. If so, the code should be in the user form's code module. If you have a text box in your worksheet paste the code to the code module of the sheet on which the text box resides.
Now, you need to adjust this line of code If Len(.Value) = 3 Then to determine when to process the data. This is because the Change event will occur whenever even a single character is entered. I tested with 3 characters. Change the number to a value equal to the length of the numbers you scan in. In theory that still leaves the CR hanging which your scanner might also send. If that causes a problem experiment with >= in place of the = in my code.
The code will add the scan to the existing quantity, just as you had it, and indicate the new total in the text box, in case you are interested. You might replace this with "OK". The code will select the text it enters. Therefore when you enter something else, such as a new scan, it will be over-written without extra clicks being required.
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.
The routine below allows the user to toggle where they have completed/not completed the required entry. The button text changes to Complete/Incomplete and the adjacent cell goes green/red using simple conditional formatting on the 0 or 1 value. Works fine for updating a single line.
The number of data entry rows will vary for each user (say 10 to 100) and I am trying to find a way of selecting and then changing all the buttons in the sheet to "Complete" and updating the adjacent cell to 0 or 1 in one go, should the user want to do that.
Each row is a data entry line and each cell in Column B has a button, and a 0/1 in adjacent cell in Column C.
Sub complete()
'Complete / Incomplete Buttton and Flag
Dim buttontext As String
buttontext = Application.Caller
ActiveSheet.Buttons(Application.Caller).TopLeftCell.Select
ActiveCell.Select
If ActiveSheet.Buttons(buttontext).Caption = "Mark as Incomplete" Then
ActiveSheet.Buttons(buttontext).Caption = "Mark as Complete"
ActiveCell.Offset(0, 1).Value = 1
Else
ActiveSheet.Buttons(buttontext).Caption = "Mark as Incomplete"
ActiveCell.Offset(0, 1).Value = 0
End If
End Sub
Following code works:
Sub MarkAllComplete()
Dim btn As Button
For Each btn In ActiveSheet.Buttons
btn.Caption = "Mark as Complete"
Cells(btn.TopLeftCell.Row, btn.TopLeftCell.Column + 1) = 0
Next
End Sub
Use this concept:
For Each btn In ActiveSheet.Buttons
Debug.Print btn.Name, btn.TopLeftCell.Column, btn.TopLeftCell.Row
Next