I have an ActiveX Checkbox in Excel that when clicked will change a cell value to add 1.
I need to repeat this VBA code when I use the same Checkbox in a different Cell Value, which I need to repeat many times.
How do I reference the automatically generated checkbox name variable in the VBA code for each new cell value?
This is for a Excel spreadsheet that I use to update a database when new reports are turned in with "checked" information on it.
Private Sub CheckBox21_Click()
Range("L2").Activate
'Don't want to type CheckBoxXX each time, just find way to automatically reference?'
If CheckBox21.Value = True Then
ActiveCell.Value = ActiveCell.Value + 1
Else
If ActiveCell.Value > 0 Then
ActiveCell.Value = ActiveCell.Value - 1
Else
End If
End If
_____________________________________________________________________________
'Next line'
Private Sub CheckBox22_Click()
Range("L2").Activate
If CheckBox22.Value = True Then
ActiveCell.Value = ActiveCell.Value + 1
Else
If ActiveCell.Value > 0 Then
ActiveCell.Value = ActiveCell.Value - 1
Else
End If
End If
End Sub
I don't want to type CheckBoxXX each time, just to automatically reference?
Related
I would have a question regarding VisualBasics for Application (VBA) in Excel.
I need to include two buttons on my worksheet(add and delete).
When pressing the add button a new block of values should be added below one existing block, separated by a blank row.
When pressing the delete button the a block should become deleted.
-> see pictures
My current state is the following one.
Copy and paste works, but only for one single line not for multiple lines
Sub AddLibs()
Dim r As ListObject
Dim c As Integer
ActiveSheet.Unprotect "test"
ActiveSheet.ListObjects("data").ListRows(ActiveCell.Row).Range.Select
Set r = ActiveSheet.ListObjects("data")
c = r.Range.Rows.Count
ActiveSheet.ListObjects("data").Resize Range("A1:B" & c)
Selection.Copy
Selection.Insert Shift:=xlToDown, CopyOrigin:=xlFormatFromRightorAbove
Application.CutCopyMode = False
ActiveSheet.Protect "test", True, True
End Sub
I found an appropriate solution.
Implementation looks like this
Adding a block
Sub AddLibs()
If Cells(Selection.Row, 1).Value = "name" Then
ActiveSheet.Unprotect "test"
For counter = 0 To 3
ActiveCell.Offset(counter + 4, 0).EntireRow.Insert
ActiveCell.Offset(counter + 4, -1).Value = ActiveCell.Offset(counter, -1)
Next counter
ActiveSheet.Protect "test", True, True
Else
MsgBox "Please klick into a library Cell to add a new one!", , "Not possible action"
End If
End Sub
deleting a block
Sub DeleteLibs()
If Cells(Selection.Row, 1).Value = "name" Then
ActiveSheet.Unprotect "test"
For counter = 3 To 0 Step -1
ActiveCell.Offset(counter, 0).EntireRow.Delete
Next counter
ActiveSheet.Protect "test", True, True
Else
MsgBox "Please klick into the library Cell and push button again to delete!", , "Not possible action"
End If
End Sub
Why are you copy-pasting?
I have just put three values in A1, A2 and A3, and I have run this piece of code:
Range("B1:B3").Value = Range("A1:A3").Value
The values from A1:A3 have been copied to B1:B3. As you see, there's a very easy way to copy ranges without using the clipboard (.Copy, .Paste).
Using VBA in excel, trying to understand how I can use a checkbox to hide/unhide any row that has a specific value in a specific column. My VBA skills are getting better more I practice but I am still not good with loops just yet. Appreciate any help you can provide. Here is what I have so far.
Private Sub CkBx_ShowAllRecords_Click()
If Me.CkBx_ShowAllRecords = True Then
For Each Row In Range("Table1").ListObject.ListColumns
If Row.Cells(1, "column5").Value = "Submission Complete" Then
Application.EntireRow.Visible=True
Next
End if
End Sub
Additionally when I uncheck the box I would want all rows where column 5 cell value equals "submission complete" would be hidden (just the opposite of what I put above when I check the box control).
Hope this may help you:
Private Sub CkBx_ShowAllRecords_Click()
Dim i As Long
If Me.CkBx_ShowAllRecords = True Then
For i = 1 To ActiveSheet.ListObjects("Table1").Range.Rows.Count
If ActiveSheet.ListObjects("Table1").DataBodyRange(i, 5).Value = "Submission Complete" Then
Rows((i + 1) & ":" & (i + 1)).Select
Selection.EntireRow.Hidden = True
End If
Next i
Else
ActiveSheet.Rows.EntireRow.Hidden = False
End If
Me.Hide
End Sub
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 an Excel spreadsheet with a listbox on sheet1 that populates from a named group on sheet2. There are 4 entries in this named group.
I want the user to make a selection from this listbox (1 column) before they do anything else. I'm trying to code to check for a valid selection from the listbox but, TopIndex = 0, and .Value, .Selection, .Selected either don't work or they return 0 but 0 is the index for the first entry in the listbox so it's like I always make a selection.
If I check for Listbox.value <> "" it returns null whether or not I make a selection.
I've searched the internet all night looking for a solution and keep coming up empty handed.
I'm stuck. Looking for suggestions.
You are possibly looking for this piece of code
If ListBox1.ListIndex = -1 Then
MsgBox "Nothing selected"
Else
MsgBox "Selected: " & ListBox1.ListIndex
End If
Listindex is equal -1 if nothing is selected in the listbox. Otherwise it is the index of the selected element starting with 0.
The above code works for a listbox where multiselect is false.
For a listbox with "multiselection" on this piece of code might probably help you
Dim i As Long
For i = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(i) = True Then
MsgBox "Selected: " & i
End If
Next i
Not sure why it didn't work for me but when I used
listbox1.listindex I kept getting 0
So, I changed how I populated my listbox by using
Private Sub Workbook_Open()
' Add site names to listbox
With Sheet1.ListBox1
.AddItem "Hayward"
.AddItem "Exeland"
.AddItem "StoneLake"
.AddItem "Winter"
End With
End Sub
Later on, when I coded to define the file I needed to open, I used
x = Sheet1.ListBox1.ListIndex
Select Case x
Case 0
sSite = "Hayward"
Case 1
sSite = "Exeland"
Case 2
sSite = "StoneLake"
Case 3
sSite = "Winter"
Case Else
MsgBox "You MUST select a Site Location", vbOKOnly
GetTargetFile = "NoSite"
Exit Function
End Select
GetTargetFile = sSite & sMonth & Yr & ".xlsx"
Now, Listbox1.ListIndex will return -1 if no selection made.
I think my original problem was in how I was trying to populate my listbox in that no matter what I did, both the FIRST and NO SELECTION returned 0.
Thanks for responding!
You need to count the selected items, then make the condition:
For a = 0 To Me.ListBox1.ListCount - 1
If Me.ListBox1.Selected(a) = True Then
Numselections = Numselections + 1
End If
Next a
If Numselections < 1 Then
MsgBox ("Please select item!")
Exit Sub
End If
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