I have problem. How to enable/disable a button depending on the cell value.
In excel sheet i have 2 buttons.
What i need to do is.
If a column "L" having data
The one button enable
else
"BQ" is having data
another button needs to be enabled.
Other button will be disabled.
How to achieve it.
Please help ....
Thanks in advance
I was waiting for your reply as to what should happen if both are filled up. I have added that option in the code. Amend it to suit your needs.
Try this
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Whoa
Application.EnableEvents = False
CommandButton1.Enabled = False: CommandButton2.Enabled = False
'~~> If both cols are filled up
If Application.WorksheetFunction.CountA(Columns(12)) > 0 And _
Application.WorksheetFunction.CountA(Columns(69)) > 0 Then
'~~> Change the message as applicable
MsgBox "Both Columns Cannot have data", vbInformation, "Error"
Else
'~~> If Col L is filled up
If Application.WorksheetFunction.CountA(Columns(12)) > 0 _
Then CommandButton1.Enabled = True
'~~> If Col BQ is filled up
If Application.WorksheetFunction.CountA(Columns(69)) > 0 _
Then CommandButton2.Enabled = True
End If
LetsContinue:
Application.EnableEvents = True
Exit Sub
Whoa:
MsgBox Err.Description
Resume LetsContinue
End Sub
Replace CommandButton1 and CommandButton2 with whatever the names of your buttons are.
Private Sub Worksheet_Change(ByVal Target As Range)
If Application.WorksheetFunction.CountA(Range("L:L")) > 0 Then
CommandButton1.Enabled = True
Else
CommandButton1.Enabled = False
End If
If Application.WorksheetFunction.CountA(Range("BQ:BQ")) > 0 Then
CommandButton1.Enabled = False
CommandButton2.Enabled = True
Else
CommandButton1.Enabled = True
CommandButton2.Enabled = False
End If
End Sub
Related
I have a spreadsheet where I have adapted two pieces of VBA code to perform two different double click event actions.
The 1st piece of code enters a "✓" in a specific range of cells when double clicked and removes it when double clicked again:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("H2:H600,M2:V600")) Is Nothing Then
Application.EnableEvents = False
If ActiveCell.Value = ChrW(&H2713) Then
ActiveCell.ClearContents
Else
ActiveCell.Value = ChrW(&H2713)
End If
Cancel = True
End If
Application.EnableEvents = True
End Sub
The 2nd piece of code enters a date/time stamp in a range of cells when double clicked:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'Coded by SunnyKow - 16/09/2016
Application.EnableEvents = False
On Error GoTo ErrorRoutine
'You can change the range here
If Not Intersect(Target, Range("L2:L600,Y2:Y600")) Is Nothing Then
'Update only if cell is empty
If Target = "" Then
Target = Now
End If
Cancel = True
End If
Application.EnableEvents = True
Exit Sub
ErrorRoutine:
Application.EnableEvents = True
End Sub
Because you cannot have two double click events in single worksheet (as separate VBA code), how do I merge these two pieces of VBA so that it is a single piece of code with two distinct actions based on the cell range selected. Would appreciate any help to resolve this.
It looks like an if statement will do the trick
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Application.EnableEvents = False
On Error GoTo ErrorRoutine
If Not Intersect(Target, Range("L2:L600,Y2:Y600")) Is Nothing Then
'Update only if cell is empty
If Target = "" Then
Target = Now
End If
Cancel = True
ElseIf Not Intersect(Target, Range("H2:H600,M2:V600")) Is Nothing Then
Application.EnableEvents = False
If ActiveCell.Value = ChrW(&H2713) Then
ActiveCell.ClearContents
Else
ActiveCell.Value = ChrW(&H2713)
End If
Cancel = True
End If
Application.EnableEvents = True
Exit Sub
ErrorRoutine:
Application.EnableEvents = True
End Sub
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Application.EnableEvents = False
On Error GoTo ErrorRoutine
If Not Intersect(Target, Range("L2:L600,Y2:Y600")) Is Nothing Then
If Target = "" Then
Target = Now
End If
Cancel = True
ElseIf Not Intersect(Target, Range("M2:V600")) Is Nothing Then
If ActiveCell.Value = ChrW(&H2713) Then
ActiveCell.ClearContents
Else
ActiveCell.Value = ChrW(&H2713)
End If
Cancel = True
ElseIf Not Intersect(Target, Range("H2:H600")) Is Nothing Then
If ActiveCell.Value = ChrW(&H2713) Then
ActiveCell.ClearContents
Else
ActiveCell.Value = ChrW(&H2713)
Target.Offset(0, 18) = Now
End If
Cancel = True
End If
Application.EnableEvents = True
Exit Sub
ErrorRoutine:
Application.EnableEvents = True
End Sub
Im not very familiar with VBA code and was hoping someone could help me with this code.
Im trying to replace 3 different ranges with 3 different values.
The current code ive got seems to only execute the first line and the last 2 lines are ignored
Private Sub CommandButton3_Click()
Range("B2, F1, F3:f5, F20, F22:F24") = "Enter Text Here..."
Range("C2, F2, F21") = "Select 1"
Range("C3:C10, B13:B19, B22:B25, A29:D33,F7:F16, F26:F35").ClearContents
End Sub
Any help or direction would be appreciated! Thanks in advance
Heres the whole code;
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
If Me.Range("B56").Value = 0 Then
Dim xsheet As Worksheet
Set xsheet = Sheets("Heroes_list")
If xsheet.Name <> "Definitions" And xsheet.Name <> "fx" And xsheet.Name <> "Needs" Then
xsheet.Range("A2:AC2").Copy
xIntR = xsheet.UsedRange.Rows.Count
xsheet.Cells(xIntR + 1, 1).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
MsgBox "Saved Successfully!"
End If
Application.ScreenUpdating = True
Else
If Me.Range("B56").Value = 1 Then _
MsgBox "Not allowed, please revise costs, conflicts and all fields are filled correctly."
End If
Application.ScreenUpdating = True
End If
Application.ScreenUpdating = True
End Sub
Private Sub CommandButton2_Click()
Application.DisplayAlerts = False
Worksheets("Heroes_list").Copy ' golly im good
With ActiveWorkbook
ChDir "C:\Users\Evane\Documents\Calix\Photoshop_excel_imports\"
.SaveAs Filename:="C:\Users\Evane\Documents\Calix\Photoshop_excel_imports\hero" & ".txt", FileFormat:=xlText, CreateBackup:=False
.Close False
End With
Application.DisplayAlerts = True
MsgBox "Exported successfully!"
End Sub
Private Sub Worksheet_Calculate()
If Me.Range("B52").Value = 1 Then _
MsgBox "The current effect combination for this PRIMARY ATTACK is invalid,Please ensure that if negative effects are listed, the list starts with atleast 1 negative status effect or that the effect list starts at line 1."
End
If Me.Range("B54").Value = 1 Then _
MsgBox "The current effect combination for this SECONDARY ATTACK is invalid,Please ensure that if negative effects are listed, the list starts with atleast 1 negative status effect or that the effect list starts at line 1."
End
If Me.Range("A49").Value > 1 Then _
MsgBox "Element conflict! The same element cannot be listed under both weakness and resistance!"
End
End Sub
Public Sub PasteasValue()
Selection.PasteSpecial Paste:=xlPasteValues
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Range("b56") = 1 Then Sheets("Hero_creation").CommandButton1.BackColor = RGB(255, 0, 0) 'Red!
If Range("b56") = 1 Then Sheets("Hero_creation").CommandButton1.Font.Strikethrough = True 'strikethrough text
If Range("b56") = 0 Then Sheets("Hero_creation").CommandButton1.BackColor = RGB(0, 255, 0) 'Green!
If Range("b56") = 0 Then Sheets("Hero_creation").CommandButton1.Font.Strikethrough = False 'No strik through text
End Sub
'New Code
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.address = "$B$2" Or Target.address = "$F$1" Or Target.address = "$F$20" Or Target.address = "$C$2" Or Target.address = "$F$2" Or Target.address = "$F$3" Or Target.address = "$F$4" Or Target.address = "$F$5" Or Target.address = "$F$21" Or Target.address = "$F$22" Or Target.address = "$F$23" Or Target.address = "$F$24" Or Target.address = "$C$3" Or Target.address = "$C$4" Or Target.address = "$C$5" Or Target.address = "$C$6" Or Target.address = "$C$7" Or Target.address = "$C$8" Or Target.address = "$C$9" Or Target.address = "$C$10" Then
If Target.Value = "" Then ' case a cell was emptied
Let Application.EnableEvents = False
Let Target.Value = "Enter Text Here..."
Let Application.EnableEvents = True
Else ' case a text was entered
With Target.Font
.ColorIndex = xlAutomatic
.TintAndShade = 0
End With
End If
Else
' Target is Not a cell to be acted on
End If
End Sub
Private Sub CommandButton3_Click()
Range("B2, F1, F3:f5, F20, F22:F24") = "Enter Text Here..."
Range("C2, F2, F21") = "Select 1"
Range("C3:C10, B13:B19, B22:B25, A29:D33,F7:F16, F26:F35").ClearContents
End Sub
In your Worksheet_Calculate event, you are missing the If in your Ends which ends up as a End statement, this stops the entire procedure immediately
I have also removed _ after Then.
Full code below:
Private Sub Worksheet_Calculate()
If Me.Range("B52").Value = 1 Then
MsgBox "The current effect combination for this PRIMARY ATTACK is invalid,Please ensure that if negative effects are listed, the list starts with atleast 1 negative status effect or that the effect list starts at line 1."
End If
If Me.Range("B54").Value = 1 Then
MsgBox "The current effect combination for this SECONDARY ATTACK is invalid,Please ensure that if negative effects are listed, the list starts with atleast 1 negative status effect or that the effect list starts at line 1."
End If
If Me.Range("A49").Value > 1 Then
MsgBox "Element conflict! The same element cannot be listed under both weakness and resistance!"
End If
End Sub
I assume Worksheet_Calculate is triggered because you have formula(s) from other cells that are affected by the change so if you do not want that to be triggered, manipulate Application.EnableEvents property:
Private Sub CommandButton3_Click()
Application.EnableEvents = False
Range("B2, F1, F3:f5, F20, F22:F24") = "Enter Text Here..."
Range("C2, F2, F21") = "Select 1"
Range("C3:C10, B13:B19, B22:B25, A29:D33,F7:F16, F26:F35").ClearContents
Application.EnableEvents = True
End Sub
This code shows ListBox1 when cell A2 is clicked, hides it when A2 is clicked a second time or ListBox1 is no longer selected. The selections are output to A2.
The problem is that after A2 is clicked once to open and once to close, you must click another cell before clicking on A2 again to create the perceived toggle effect of the ListBox.
I have tried repeating Application.EnableEvents = False [A3].Select Application.EnableEvents = True just before End If however when trying to select any other cell on the sheet, only A3 is selected.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
With ActiveSheet.ListBox1
If Target(1).Address = "$A$2" And .Visible = False Then
.Visible = True
Application.EnableEvents = False
[A3].Select
Application.EnableEvents = True
Else
.Visible = False
For I = 0 To .ListCount - 1
If .Selected(I) Then txt = txt & ", " & .List(I)
Next
[A2] = Mid(txt, 2) 'remove first comma and output to A2 cell
End If
End With
End Sub
Question Updated to include the answer provided, while incorporating part of the code from above to output the ListBox selections to cell A2. The new problem is that the selections already made, continue to multiply in cell A2 everytime the ListBox is closed, rather than only adding new selections.
Option Explicit
Dim SelectCell As Boolean
Dim i As Long
Dim txt As String
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
With ActiveSheet.ListBox1
If Target(1).Address = "$A$2" And .Visible = False Then
.Visible = True
Application.EnableEvents = False
[A3].Select
Application.EnableEvents = True
SelectCell = True
Else
.Visible = False
For i = 0 To .ListCount - 1
If .Selected(i) Then txt = txt & ", " & .List(i)
Next
[A2] = Mid(txt, 2) 'remove first comma and output to A2 cell
If SelectCell = True Then
Application.EnableEvents = False
[A3].Select
Application.EnableEvents = True
SelectCell = False
End If
End If
End With
End Sub
Yes this works however when you click any other cell in the sheet it keeps selecting cell A3. I will clarify question. Thanks – aye cee 1 min ago
Is this what you are trying?
Option Explicit
Dim SelectCell As Boolean
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
With ActiveSheet.ListBox1
If Target(1).Address = "$A$2" And .Visible = False Then
.Visible = True
Application.EnableEvents = False
[A3].Select
Application.EnableEvents = True
SelectCell = True
Else
.Visible = False
If SelectCell = True Then
Application.EnableEvents = False
[A3].Select
Application.EnableEvents = True
SelectCell = False
End If
End If
End With
End Sub
The Listbox should open and close endless times by clicking A2 or close by clicking outside, while also allowing selection of other cells on the sheet. Yes I included all code. On your end can you repeatedly click A2 to open close without selecting any other cell? – aye cee 2 mins ago
It does exactly that. See this
Alternate solution
Use Worksheet_BeforeDoubleClick with Worksheet_SelectionChange. See this. Now the ListBox1 will show everytime you double click on A2 and hide when any other cell is selected.
Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target(1).Address = "$A$2" And ListBox1.Visible = False Then
ListBox1.Visible = True
Cancel = True
Else
ListBox1.Visible = False
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If ListBox1.Visible = True Then ListBox1.Visible = False
End Sub
I see that you already have a solution. However, for what it's worth, here is another approach. I think it allows you more flexibility to control what the ListBox shows when it is displayed.
Option Explicit
Private Const Trigger As String = "A2"
Private Sub ListBox1_LostFocus()
' 238
Dim Txt As String
Dim i As Integer
With ListBox1
For i = 0 To .ListCount - 1
If .Selected(i) Then
If Len(Txt) Then Txt = Txt & ","
Txt = Txt & .List(i)
End If
Next i
Range(Trigger).Value = Txt
End With
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
' 238
With ListBox1
If Target.Address(0, 0) = Trigger Then
.Visible = True
.ListFillRange = "P2:P9"
Else
.Visible = False
End If
End With
End Sub
In the above setup the ListBox is displayed when the user clicks on A2. He can then make a selection and transfer it to A2 by clicking anywhere outside the ListBox. However, if he clicks on A2 he can see both his selection and its transscription to A2, and go back to the ListBox to change the selection.
I use the below VBA code to display a checkmark/tick when a cell is double clicked. At times, the checkmark/tick needs to be removed. To remove the checkmark/tick, the cell needs to be double clicked again. Once double clicked to remove the checkmark/tick, the cell return as blank. My question is; would it be possible to display the word ‘YES’ rather than having the cell blank?
Or as an even better option, is it possible to return the original text (before the cell was even double clicked) in the cell when double clicked (to remove checkmark/tick) rather than return as blank?
I hope this makes sense! Thank you in advance!
Below is the VBA code I have used for the checkmark/tick:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
On Error GoTo 1
If Not Intersect(Target, Range("A2:Z200")) Is Nothing Then
Application.EnableEvents = False
If Target.Value = ChrW(&H2713) Then
Target.ClearContents
Cancel = True
Else
Target.Value = ChrW(&H2713)
Cancel = True
End If
End If
On Error GoTo 0
1 Application.EnableEvents = True
End Sub
To display the word "YES" change the line :
Target.ClearContents
With:
Target.Value = "YES"
Full Code
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
On Error GoTo 1
If Not Intersect(Target, Range("A2:Z200")) Is Nothing Then
Application.EnableEvents = False
If Target.Value = ChrW(&H2713) Then
Target.Value = "YES"
Else
Target.Value = ChrW(&H2713)
End If
Cancel = True
End If
On Error GoTo 0
1 Application.EnableEvents = True
End Sub
This will replace the original value with a checkmark and then restore the original value on re-clicking, but it only works for text values and only changes the appearance of the cell...
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("A2:Z200")) Is Nothing Then
On Error GoTo haveError
Application.EnableEvents = False
If Target.NumberFormat Like ";;;*" Then
Target.NumberFormat = "General"
Else
Target.NumberFormat = ";;;" & ChrW(&H2713)
End If
Cancel = True
End If
haveError:
Application.EnableEvents = True
End Sub
I need users to be able to fill in one row to generate a P.O., and when the P.O. is generated the row below would be unhidden. The P.O. depends on column C, E and G to be filled in.
This code only unhides a row if one of the requirements are met. It also makes the workbook lag.
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Target.Row < 14 Or Target.Row > 5000 Or Target.Column < 3 Or Target.Column < 5 Or Target.Column <> 7 Then GoTo ExitMe
Rows(Target.Row + 1).Hidden = False
ExitMe:
Application.EnableEvents = True
End Sub
I need one row to be filled in at a time so the P.O. can be generated properly. If there is a better way please let me know.
This macro also conflicts with my macro for protecting changed cells when the worksheet is saved. This is the error that appears: Run-time error '1004': Unable to set hidden property of the Range class.
It is placed in ThisWorkbook
Option Explicit
Private bRangeEdited As Boolean
Private WithEvents ws As Worksheet
Private Sub Workbook_Open()
Set ws = Range("A14:Y3000").Parent
End Sub
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim sMSG As String
sMSG = "saving the workbook will lock the cells you have entered data into." & vbLf
sMSG = sMSG & "Do you want to go ahead ?"
If Not bRangeEdited Then GoTo Xit
If Not Me.ReadOnly Then
With Range("A14:Y3000")
If MsgBox(sMSG, vbExclamation + vbYesNo) = vbNo Then
Cancel = True
GoTo Xit
End If
.Parent.Unprotect "password"
If .SpecialCells(xlCellTypeBlanks).Address <> .Address Then
.SpecialCells(xlCellTypeConstants).Locked = True
bRangeEdited = False
End If
.Parent.Protect "password"
End With
End If
Xit:
End Sub
Private Sub ws_Change(ByVal Target As Range)
If Not Intersect(Range("A14:Y3000"), Target) Is Nothing Then
bRangeEdited = True
End If
End Sub