I have list of employees that I update and that's why I would like to gather names by VBA:
Private Sub CommercialBox_DropButtonClick()
Application.ScreenUpdating = False
Dim RngCom As Range
ThisWorkbook.Sheets("MAIN").CommercialBox.Clear
With ThisWorkbook.Sheets("Contact database")
For Each RngCom In .Range("B61:B77")
If RngCom.Value <> vbNullString Then ThisWorkbook.Sheets("MAIN").CommercialBox.AddItem RngCom.Value
Next RngCom
End With
Application.ScreenUpdating = True
End Sub
This is connected to DropButtonClick and works fine.
Now I need to connect also cell value to dropdown box so user will see what he has chosen. There is a small time gap between code is entering value to Worksheet. That's why this code does not work really:
Private Sub Worksheet_Change(ByVal Target As Range)
ThisWorkbook.Sheets("MAIN").CommercialBox.Value = ThisWorkbook.Sheets("Contact database").Range("I109").Value
End Sub
I have tried also this way, but it more like workaround than correct solution:
Private Sub CommercialBox_LostFocus()
ThisWorkbook.Sheets("MAIN").CommercialBox.Value = ThisWorkbook.Sheets("Contact database").Range("I109").Value
End Sub
How to repair that issue?
Related
I want a msgbox to show up only once when formula result changes in my table range ("K2:K5"). Right now it shows twice.
In this range I have excel-formulas. Formula: H12*10
These formulas is refering to a dropdown-list (a list that I've created from "data validation" on the excel menu Data-tab).
The dropdown-list is located in cell H12.
The values in the dropdown is refering to range(D15:D17)
I've noticed though that the msgbox shows up once when I remove the dropdown and manualy type in values in H12.
Thankful for any help on this
Private Sub Worksheet_Calculate()
Dim Xrg As Range
Set Xrg = Range("K2:K5")
If Not Intersect(Xrg, Range("K2:K5")) Is Nothing Then
MsgBox "Hi"
End If
End Sub
I have also tried to add Application.enableEvents to the code but no success.
Private Sub Worksheet_Calculate()
Dim Xrg As Range
Set Xrg = Range("K2:K5")
Application.EnableEvents = False
If Not Intersect(Xrg, Range("K2:K5")) Is Nothing Then
MsgBox "Hi"
End If
Application.EnableEvents = True
End Sub
Your current code has no added value on a Worksheet_Calculate event due to comparing two exact same ranges and see if they intersect. That would always be the case. Your code would have the same effect as:
Private Sub Worksheet_Calculate()
MsgBox "Hi"
End Sub
Might you have more functions in your worksheet that could trigger this event unwanted outside range K2:K5, you should look into the Worksheet_Change event and return a messagebox when your referenced cell has changed value.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$H$12" Then MsgBox "Hi"
End Sub
Choose either one, but don't use both cause you'll end up with two msgbox's
I'm creating a quiz.
Questions on one worksheet and the answers on another.
When a question is answered another field with this formula
=IF(C5="","",IF(C5=Answers!A5,"Correct","Incorrect"))
tells the person if the answer is correct or incorrect.
I am using data validation with dropdown lists so they can only choose true/false, (a, b, c, d) etc.
Is there a way to lock in a selected answer, until a master reset button is pressed?
For example,
Question is in A1
The possible answers are in the form of a dropdown menu in B1.
Sometimes the answer is in the form of a true false, sometime it is in the form of a multiple choice. In the example of true false, if the person puts in true, c3 will say correct or if they put false, then incorrect.
As it is now, the person can switch back and forth as much as they want.
I am looking to make it so once an answer is selected, they cannot change it.
You can use Sheet Protection, combined with Range Locking and a Change event.
Put this code in the relevant Worksheet Module. Adjust the Private constants to suit your needs.
Option Explicit
' Reference the cells that your users may enter data into
Private Const DataCells As String = "J1,J3,J5"
Private Const PW As String = "password"
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cl As Range
Dim DataRange As Range
Set DataRange = Me.Range(DataCells)
'Loop thru changed cells
For Each cl In Target.Cells
'If changed cell is in the DataCells range and is not blank, lock it
If Not Application.Intersect(cl, DataRange) Is Nothing Then
If Not IsEmpty(cl) Then
Me.Unprotect PW
Target.Locked = True
Me.Protect PW
End If
End If
Next
End Sub
'Re-enable data entry to all DataCells
Sub MasterReset()
'Unlock the sheet, prompt for password
Me.Unprotect
'Unlock the cells
Me.Range(DataCells).Locked = False
'Optional, clear DataCells
Me.Range(DataCells).ClearContents
'Lock the sheet again
Me.Protect PW
End Sub
This works pretty good:
In the "This Workbook" module, insert the code:
Private Sub Workbook_Open()
Sheet1.Protect userinterfaceonly:=True 'allows macros to run
Sheet1.Range("A1:A20").Locked = False 'replace this range with the range the user deals with.
End Sub
In the sheet module that the user will be interacting with, add this code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Locked = True Then Exit Sub
If Target.Locked = False Then
If Target.Value = "" Then Exit Sub
If Target.Value <> "" Then Target.Locked = True
End If
End Sub
That should take care of things for you!
Hej,
I've created a small VBA code to dynamically rename a worksheet.
It's working perfectly when the cell is just manually typed.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("C9")) Is Nothing Then
ActiveSheet.Name = ActiveSheet.Range("C9")
End If
End Sub
But then as soon as I will put a formula concatenating 2 cells values within C9 cell it will not update it automatically.
To make it work I need to enter the cell and type ENTER again and it works.
I have to do same manipulation each time I change a value in on of the 2 cell concatenated.
THANKS for your help guys
You need to capture a different event:
Private Sub Worksheet_Calculate()
Application.EnableEvents = False
ActiveSheet.Name = ActiveSheet.Range("C9")
Application.EnableEvents = True
End Sub
NOTE:
We disable events during the name change in case the worksheet contains a formula referencing the tab-name.
this should work:
replace
ActiveSheet.Name = ActiveSheet.Range("C9")
by
ActiveSheet.Name = ActiveSheet.Range("C9").Value
This is an alternate answer if someone still wants to execute this on worksheet change event
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
Dim formulacell As Range
Set formulacell = Range("C9")
Set formulacell = Application.Union(formulacell, formulacell.Precedents)
If Not Intersect(Target, formulacell) Is Nothing Then
ActiveSheet.Name = ActiveSheet.Range("C9").Value
End If
Application.EnableEvents = True
End Sub
I am trying to hide a commandbutton based on a specific cell value. I have looked up several codes and pasted them in excel (in the vba form when right clicking the sheet and selecting "view code").
What am I doing wrong?
Here's one of the codes I've tried:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Range("A1") = 0 Then ActiveSheet.CommandButton1.Visible = False
If Range("A1") = 1 Then ActiveSheet.CommandButton1.Visible = True
End Sub
Make sure you enable events before using your code. Also, you must place your code in Worksheet module, not in regular module. To enable events, use this simple sub.
Sub Enable_events()
Application.EnableEvents = True
End Sub
please run this first:
Sub enable_()
Application.EnableEvents = True
End Sub
and then your Code will run perfectly:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Range("A1") = 0 Then ActiveSheet.CommandButton1.Visible = False
If Range("A1") = 1 Then ActiveSheet.CommandButton1.Visible = True
End Sub
Your code is confusing, for a number of reasons.
Range, when it's not qualified with a Worksheet object, implicitly refers to the ActiveSheet, i.e. ActiveSheet.Range... but when it's in a worksheet's code-behind, it implicitly refers to that worksheet's Range property, i.e. Me.Range. Because the meaning of an unqualified Range call depends on context, it's best to always qualify it with an explicit Worksheet object.
So if you're in the code-behind module for Sheet1, then Range("A1") is equivalent to Sheet1.Range("A1"), or even better, Me.Range("A1").
The two conditions will be evaluated every time, but only one of them needs to be: it's inefficient.
Truth is, you don't need to assign a Boolean literal - a Boolean expression is much cleaner.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Me.CommandButton1.Visible = (Me.Range("A1") = 1)
End Sub
Now, assuming Application.EnableEvents returns True, that code will run every time the selection changes, which is rather overkill.
Handle the Worksheet.Change event instead, and only act when the modified cell is A1:
Private Sub Worksheet_Change(ByVal Target As Range)
If Application.Intersect(Target, Me.Range("A1")) Is Nothing And Target.Count <> 1 Then
' we don't care about that cell: bail out
Exit Sub
End If
Me.CommandButton1.Visible = (Me.Range("A1") = 1)
End Sub
Please try this code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A1")) Is Nothing Then
If Selection.Cells.Count = 1 Then
If Range("A1") = 0 Then ActiveSheet.CommandButton1.Visible = False
If Range("A1") = 1 Then ActiveSheet.CommandButton1.Visible = True
End If
End If
End Sub
Hope this help.
Is there's any way to restrict the user from deleting the cell contents without using the protect method of excel. I have this code:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Sheet1")
If Not Intersect(Target, Range("C21:D" & ws.Range("C" & ws.Rows.Count).End(xlUp).Row)) Is Nothing Then
Cancel = True
MsgBox "You are not allowed to edit!", vbCritical + vbOKOnly
EndIf
End sub
But this only disallows the editing of the cell contents. I want make a function that would disallow the editing and deleting the data in a cell without using the protect method. Thanks!
Without lock and unlock, you can use this.
We have there one global variable to store selection value (to preserve beforechange state). Function SelectionChange, updating value of current cell, so we can restore cell value after users try.
Sub worksheet_change just controling, if user targeting specified row and column (can be adjusted for whole range), and if he try to change value, he is prompted and value is set back.
Dim prevValue As Variant
Private Sub worksheet_SelectionChange(ByVal target As Range)
prevValue = target.Value
End Sub
Private Sub worksheet_change(ByVal target As Range)
If target.Row = 5 And target.Column = 5 Then
If target.Value <> prevValue Then
target.Value = prevValue
MsgBox "You are not allowed to edit!", vbCritical + vbOKOnly
End If
End If
End Sub
edit: disable editing every cell which is not empty
Private Sub worksheet_change(ByVal target As Range)
If prevValue <> "" Then
If target.Value <> prevValue Then
target.Value = prevValue
MsgBox "You are not allowed to edit!", vbCritical + vbOKOnly
End If
End If
End Sub
Try my idea. Copy and paste these codes into the module of the sheet where the protected range is located. In my case it was called "Arkusz1". The protected range is "A1:A10".
Private Sub Worksheet_Change(ByVal Target As Range)
For Each cell In Range("A1:A10")
If cell.Text <> Sheets("hidden").Cells(cell.Row, cell.Column) Then
Call Undoing
End If
Next cell
End Sub
Private Sub Undoing()
Application.EnableEvents = False
Application.Undo
Application.EnableEvents = True
End Sub
In the "This_worksheet" module copy and paste this code:
Private Sub Workbook_Open()
Sheets.Add
ActiveSheet.Name = "hidden"
Sheets("Arkusz1").Range("A1:A10").Copy
Sheets("hidden").Select
ActiveSheet.Paste
Sheets("hidden").Select
ActiveWindow.SelectedSheets.Visible = False
End Sub
Private Sub Workbook_Close()
Sheets("hidden").Visible = True
Sheets("hidden").Delete
End Sub
You will have to change the name of the sheet from "Arkusz1" to "Sheet1" or any other name Your sheet has got.
The idea is as follows. Upon the opening of the workbook the application creates a hidden spreadsheet into which it copies the contents of protected cells. For some technical reasons I had to hide the sheet after the copy operation, otherwise it did not work on my computer. Then, any change of the sheet "Arkusz1" triggers the event which compares the contents of the protected range with the same range in the hidden sheet.
If there are any differences the application undoes the last action of the user.
Undoing has to be done when event handling by Excel is turned off, because undoing a previous action is also an event of changing the sheet and we would cause a cascade of events - every undo operation would trigger the event "worksheet_change" and it would never stop getting activated.
Application.EnableEvents = False
Application.Undo
Application.EnableEvents = True