Requirement Explanation :-
Whenever specific input given in some field/column of excel then the user should be restricted to input for specific range of fields/columns in the same row and same sheet of excel.
Input is selected from dropdown values in each cell of fields/columns.
Other than those specific input, those specific range can be allowed for user input.
This applies for all the rows of the input column until the last cell.
Example Scenario :-
If user selects "AWB" from dropdown in the cell C6, then user should not able to provide input from DP6 to ED6 (DP6 - ED6 should be read only/not editable).
Else DP6 - ED6 cell should be enabled. (Here, we have enabling and disabling in the same row) .
Note : And no other sheet should be impacted because of this.
My code :-
WorkBook.Sheets("SheetName").Unprotect
WorkBook.Sheets("SheetName ").Range("A15:A20").Locked = False
mainworkBook.Sheets("SheetName ").Protect
Here is an example taken from the PCreview website that makes column F read-only. This can be adapted to make any cells read-only.
Dim OldValue As Variant
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 6 Then
On Error GoTo Whoops
Application.EnableEvents = False
MsgBox "Values in this column cannot be changed!"
Target.Value = OldValue
End If
Whoops:
Application.EnableEvents = True
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Column = 6 Then OldValue = Target.Value
End Sub
Related
is it possible to have some VBA to record the user for who ever last modified a specific cell? i.e., if someone opens the workbook and enters a value into A1, I'd like B1 to show the username of the person who did that, and then, if someone else opens the workbook and enters a value into A2, i'd like their user name in B2 and so on and so forth... I've playing around with examples like the below, but I'm not sure if I'm getting any closer, seems i can only grab the username for whoever last modified the workbook.
Function LastAuthor()
LastAuthor = ActiveWorkbook.BuiltinDocumentProperties("Last Author")
End Function
This inserts the windows user/network user in column B whenever one or more values are added/modified/deleted in column A.
Add this to the worksheet's private code sheet; not a public module code sheet.
private sub worksheet_change(byval target as range)
if not intersect(range("A:A"), target) is nothing then
on error goto meh
application.enableevents = false
dim t as range
for each t in intersect(range("A:A"), target)
t.offset(0, 1) = environ("user")
't.offset(0, 2) = now
next t
end if
meh:
application.enableevents = true
end sub
I've set up a worksheet that will allow the user to select preset options from a data validation list in a cell (B23). The user's selection off this one cell will then trigger certain rows to be unhidden, guiding the user to input data into only the appropriate rows. The VBA code I am using for unhiding the appropriate rows works fine, EXCEPT for the fact that whenever a user enters data into one of the unhidden rows, all the rows will hide. The user then needs to reselect their option from the initial data validation list (cell B23) to unhide the appropriate rows again. The value they enter is entered and saved in the cell, but they need to reselect their initial choice between each data entry step, which is annoying and what I'd like to fix.
I suspect that:
1)the VBA code I hobbled together doesn't account for the fact that users will be entering data into rows that are hidden / will be triggered to unhide, and/or
2) the crux of the problem is refreshing the cell with the data validation list (B23) that triggers which rows to be unhidden. I unfortunately have no idea how to do this.
Any help would be very much appreciated!!
My VBA code to hide rows is below.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim allRows As Range
Set allRows = Rows("27:64")
allRows.Hidden = True
If Not Intersect(Target, Range("B23")) Is Nothing Then
If Target.Value = "A1" Then
Rows("27:31").Hidden = False
ElseIf (Target.Value = "A10-A-S" Or Target.Value = "A10-A-P" Or Target.Value = "A10-A-T") Then
Rows("32:36").Hidden = False
ElseIf (Target.Value = "A10-B-S" Or Target.Value = "A10-B-P" Or Target.Value = "A10-B-T") Then
Rows("37:44").Hidden = False
ElseIf (Target.Value = "E19S" Or Target.Value = "E19P" Or Target.Value = "E19T") Then
Rows("46:54").Hidden = False
ElseIf (Target.Value = "E20S" Or Target.Value = "E20P" Or Target.Value = "E20T") Then
Rows("56:64").Hidden = False
End If
End If
End Sub
You're right that as soon as anyone changes anything on the worksheet, the Worksheet_Change event will fire and hide those rows.
A simple option would probably be to wrap that code around a check that the change was triggered by your dropdown:
With Target
If .Count = 1 Then
If .Row = 23 And .Column = 2 Then ' Assumes your list result is B23?
allRows.Hidden = True
' do your other checks and updates here...
End If
End If
End With
You should check if the target is B23 and if not Exit Sub. Maybe Something like this.
If Intersect(Target, Range("B23")) Is Nothing Then
Exit Sub
End If
I have an Excel sheet in which I am accepting value from the user when user enter a value a VBA will run which check the data is valid or not and if the data is not valid it will prompt a message saying invalid data. Here is my code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$D$12" Or Target.Address = "$D$13" Or Target.Address = "$D$14" Or Target.Address = "$D$15" Then
Call Room
End If
End Sub
Room method is
Sub Room()
Dim lastRow As Long
If IsNumeric(Range("i17")) Then
If [I17] < 0 Then
MsgBox "msg "
End If
End If
End Sub
In I17 cell I have a formula
=C6-(D12+(2*D13) + (2*D14) + (3*D15))
My problem is when wrong data is enter in any of the cells (D12, D13, D14, D15) then the cell should be clear automatically after showing prompt message.
How can this be done?
The first thing that you should do is clean up how you check what Target is. It could be multiple cells (Fill Down, paste a range, ...). This is accomplished by intersecting Target with the range you are interested in, and We'll store into a range variable, for later. If there is no overlap, then intersect will return an empty object, which we can test for with is Nothing.
The next thing to note is that odd things (infinite recursion) can happen if we allow the Worksheet_Change event to fire by changing a cell. To prevent this, we will turn off events before calling Room, and turn it back on after we're done.
Next we pass the range that has changed into room, so we can modify it from within that subroutine.
And, finally we modify the affected range after displaying the message. Note that I have used a command to literally clear the cell. Since you are performing calculations based on that data, you might prefer to set it to default value, like 0, using a.value = 0 instead.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim a As Range
Set a = Intersect(Target, Range("D12:D15"))
If Not a Is Nothing Then
Application.EnableEvents = False
Room a
Application.EnableEvents = True
End If
End Sub
Sub Room(a As Range)
Dim lastRow As Long
If IsNumeric(Range("I17")) Then
If Range("I17").Value < 0 Then
MsgBox "msg "
a.ClearContents
End If
End If
End Sub
As a side note, I have a used a bad variable name a, since I don't know what that range represents. You should pick something that describes to future maintainers what is going on.
use this
Private Sub Worksheet_Change(ByVal Target As Range)
Dim t As Range
Set t = Intersect(Target, [D12:D15])
Application.EnableEvents = 0
If Not t Is Nothing Then
Call Room
If [I17] < 0 Then Target.Value = ""
End If
Application.EnableEvents = 1
End Sub
I am validating input in an Excel worksheet. When the user enters invalid data a MsgBox is shown, giving the option to Abort/Retry/Ignore.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If IsNumeric(Range("i17")) Then
If [I17] < 0 Then
result = MsgBox("Critical Error Encountered", vbAbortRetryIgnore + vbCritical, "Error Encountered")
If result = 3 Then
ActiveCell.Value = Empty
End If
End If
End If
End sub
Since I have written this code in SelectionChange when I click enter then only it show the message box and since I'm writing Active.Cell = Empty it is deleting the next cell, but I mean it to clear the cell which contains invalid data.
If you use the SelectionChange event, the Target range is the cell just selected and not the cell which has just been changed. If you use the Change event of the worksheet, then Target refers to the cell that has been changed. So, assuming that cell I17 is some kind of subtotal/validation cell and not the cell into which the user enters data, try this:
Private Sub Worksheet_Change(ByVal Target As Range)
If IsNumeric(Range("i17")) Then
If [I17] < 0 Then
result = MsgBox("Critical Error Encountered", vbAbortRetryIgnore + vbCritical, "Error Encountered")
If result = 3 Then
Target.Value = Empty
Target.Select
End If
End If
End If
End Sub
This code will clear the cell just changed and change the selection back to that cell if the user selects the Abort button in the message.
Im trying to use VBA to hide/show a group of rows on a separate sheet within the same workbook named Invoice
To do this, on the InputForm sheet, there is a cell (N14) which uses =ISBLANK(D53) to check if D53 contains anything and obviously returns TRUE/FALSE
From this im trying to run an If Statement in VBA to hide/show rows based on whether the cell N14 contains TRUE/FALSE
The code i've tried works ok if i manually type TRUE/FALSE but not if it is automatically entered by the formula.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address(False, False) = "N14" Then
Select Case Target.Value
Case "TRUE": Sheets("Invoice").Rows("57:123").Hidden = True:
Case "FALSE": Sheets("Invoice").Rows("57:123").Hidden = False:
End Select
End If
End Sub
The format of Cell N14 is "Text"
As I mentioned in comments, Worksheet_Change doesn't fires when result of your formula changes. It fires only if you change value of cell itself. You should look into Worksheet_Calculate event instead:
Private Sub Worksheet_Calculate()
Application.EnableEvents = False
Sheets("Invoice").Rows("57:123").Hidden = Range("N14").Value
Application.EnableEvents = True
End Sub