Loop through range - vba

I have a cell that has a pass or fail validation (BA). If the user selects Pass from the drop down list, unit passed all tests is displayed in another cell (N). The VBA I have used to make this happen works as expected:
On Worksheet_Change
If Range("BA17").Value = "Pass" Then Range("N44").Value = "Unit passed all tests."
If Range("BA18").Value = "Pass" Then Range("N45").Value = "Unit passed all tests."
If Range("BA19").Value = "Pass" Then Range("N46").Value = "Unit passed all tests."
Is it possible to condense this, as the final sheet will have up to 25-30 lines?
I tried adding a range, i.e. ("BA17:BA40") but then this updates all fields every time, which is not ideal.

This will update Column N (row offset by 27) with value "Unit passed all tests." if only one cell in column BA is updated and current row > 17
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
With Target
If .CountLarge = 1 And .Column = Range("BA1").Column And .Row > 17 Then
If .Value2 = "Pass" Then
Application.EnableEvents = False
.Offset(27, Range("N1").Column - .Column).Value = "Unit passed all tests."
Application.EnableEvents = True
End If
End If
End With
End Sub

An option that avoids loops for multiple entries
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng1 As Range
Set rng1 = Intersect(Target, [BA17:BA40])
If rng1 Is Nothing Then Exit Sub
Application.EnableEvents = False
With rng1.Offset(27, -39)
.FormulaR1C1 = "=IF(R[-27]C[39]=""Pass"",""Unit passed all tests."","""")"
.Value = .Value
End With
Application.EnableEvents = True
End Sub

Related

Excel sheet: Lock cell and write "1" on it based on a dropdown option

I want to lock cell B20 and write "1" on it if I choose a certain option ("T") on the dropdown of B18. If I choose any other option, I want to be able to fill it normally without any limitations. Here is the best code I tried:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim ws As Worksheet
Set ws = ActiveSheet
If Target.Address = "$B$18" Then
ws.Unprotect
Application.EnableEvents = False
Target.Offset(1).Locked = Target.Value = "T"
If Target.Value = "T" Then
Target.Offset(1).Value = 1
Else
If Target.Offset(1).Value = 1 Then Target.Offset.Value = ""
End If
Application.EnableEvents = True
ws.Protect
End If
End Sub
This code is doing exactly what I want but its performing this on the cell B19 instead of B20.
Can somebody help me please?
There is a bunch of code and text all saying different things in your question, so I based this code on your comment and the text of your question.
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$B$18" Then
ws.Unprotect
Application.EnableEvents = False
Target.Offset(2).Locked = Target.Value = "T"
If Target.Value = "T" Then
Target.Offset(2).Value = 1
Else
If Target.Offset(2).Value = 1 Then Target.Offset.Value = ""
End If
Application.EnableEvents = True
ws.Protect
End If
End Sub

VBA Code. Trying to fix the "IF" PARTS

So I have this written in my VBA:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("G9:G28")) Is Nothing Then
Application.EnableEvents = False
With Target
If IsNumeric(.Value) Then .Value = .Value / 100
End With
Application.EnableEvents = True
End If
End Sub
When I try to erase the data in the "G" Cells a 0% stays locked in. I think bc ".Value/100" is the 0% that my code says must go inside that cell. The above code is suppose to turn any number into a percentage but I think I wrote it and when its suppose to be blank it shows a "0%" but I want it to be blank.
I would use a loop:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range
If Not Intersect(Target, Range("G9:G28")) Is Nothing Then
Application.EnableEvents = False
For Each r In Intersect(Target, Range("G9:G28"))
If IsNumeric(r.Value) Then r.Value = r.Value / 100
Next r
Application.EnableEvents = True
End If
End Sub
This code will allow more than one cell to be changed.
Try the code below:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("G9:G28")) Is Nothing Then
If Target.Count <= 1 Then ' make sure not more than 1 cell is changed
Application.EnableEvents = False
With Target
If IsNumeric(.Value) Then
If .Value = 0 Then
.Value = ""
Else
.Value = .Value / 100
End If
End If
End With
Application.EnableEvents = True
End If
End If
End Sub
Target can be SEVERAL cells.
And an array divided by 100 makes no sense.
Just test if the cell in question is empty with IsEmpty(Target.Value) before performing the conversion to percent, like this:
If Not IsEmpty(.Value) And IsNumeric(.Value) Then .Value = .Value / 100

Show/Hide Rows Per Dropdown Selection

I found code online as an example that I have tweaked to show or hide specific rows depending on the selection I choose within a dropdown in my Excel file.
The macro is not working no matter what I try.
My code is as follows (also attached screenshot of rows under question 2 (2a - 2d) that are not showing/hiding)
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$F$13" Then
If Range("F13").Value = "Yes" Then
Rows("14:17").EntireRow.Hidden = False
End If
If Range("F13").Value = "No" Then
Rows("14:17").EntireRow.Hidden = True
End If
If Range("F13").Value = " " Then
Rows("14:17").EntireRow.Hidden = True
End If
End Sub
This is a good example of properly intending your code helping you identify an issue. You're missing an End IF statement. Try this:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$F$13" Then
If Range("F13").Value = "Yes" Then
Rows("14:17").EntireRow.Hidden = False
End If
If Range("F13").Value = "No" Then
Rows("14:17").EntireRow.Hidden = True
End If
If Range("F13").Value = " " Then
Rows("14:17").EntireRow.Hidden = True
End If
End If
End Sub
You may also want to use:
If Range("F13").Value = ""
instead of
If Range("F13").Value = " "
There is an End If missing. I assume the value of the target cell (F13) needs to be tested for it's value. If the value is "Yes", it should unhide row 14:17, if it is " " (spacebar) it should hide them and if it is "No" is should hide them as well. Other values will not affect the hiding/unhiding of the rows.
There should be a second End If before End Sub, so that all the if-statements above are wrapped within the Address check.
Also note that this code should be placed in the worksheet itself, since you want to hook into the Worksheet_Change event.
Try this in a worksheet module:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$F$13" Then 'Check if the changed value is indeed in F13
If Target.Value = "Yes" Then
ActiveSheet.Rows("14:17").EntireRow.Hidden = False 'Show the rows if the value is Yes
ElseIf Target.Value = "No" Then
ActiveSheet.Rows("14:17").EntireRow.Hidden = True 'Hide them when it's No
ElseIf Target.Value = " " Then
ActiveSheet.Rows("14:17").EntireRow.Hidden = True 'Or space
End If
End If
End Sub
Other remarks:
Instead of ActiveSheet you can also use Me (Me.Rows...) In this scenario they probably do the same. However, if you change the value on a worksheet from another worksheet (e.g. formula that recalculates), Me will reference the changed worksheet that fires the event, whereas activeworksheet will affect the currently active sheet.
Use Target instead of referencing the Range again. Target is a range object that is already in memory. Hence execution will be faster compared to accessing the worksheet again.

Dynamically protecting cells in a row based on "Y" Value in the Checked column?

I need to protect all the cells in a particular row if my user enters Y (yes) into a column of that particular row which indicates that the user has reviewed the data and that it is correct. I have not been able to figure out how to make this happen. Does anyone know how to do this?
Thanks so much,
Elias
As per your request and Byron's comments, I edited the code. The code should be pasted into the worksheet module
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
On Error GoTo Exiter
Set Sh = Target.Parent
If Target.Value = "Y" And Target.Column = 1 Then
Unprotect Password:="WHATEVER"
For Each curRow In Sh.UsedRange.Rows
If Sh.Cells(curRow.Row, 1) = "Y" Then
Sh.Cells(curRow.Row, 1).EntireRow.Locked = True
Else
Sh.Cells(curRow.Row, 1).EntireRow.Locked = False
End If
Next
Sh.Protect Password:="WHATEVER"
End If
Exiter:
Application.EnableEvents = True
End Sub

Coding for In/Out Tracking of Tools with no repeating and text always getting added into and not deleted text input by barcode scanner

I am trying to make a code in Microsoft Excel Where it puts a text into a cell when another cell is filled in.
What I am looking for is that when cell A for example is filled cell C is filled in with OUT. Then when cell A is filled in again on the next line or another line below it cell C on the same line as cell A is filled in with IN.
We would like to utilize a barcode scanner for checking the tools in and out. I already figured out how to get the barcode to scan into column A
I would like this process to be repeated over and over again.
It's supposed to be a tracking sheet for when tools get taken out and get put back into stock. The text is going to constantly be added and nothing deleted. We want to utilize a barcode scanner to check tools in and out. The employees scan their barcode indicating them then they scan the tool indicating what tool they are taking. Then when they come back they scan their barcode again and then they scan the tool back into inventory. Of course just having this simple setup will lead to a mess of whether the tool is in or out and who used it last since we have a bunch of employees taking tools IN and OUT constantly. That way we can be sure of who used what tool last and whether it's IN or OUT.
Below I have the coding that I need for the time stamp.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim B As Range, AC As Range, t As Range
Set B = Range("B:B")
Set AC = Range("A:A")
Set t = Target
If Intersect(t, AC) Is Nothing Then Exit Sub
Application.EnableEvents = False
Range("B" & t.Row).Value = Now
Application.EnableEvents = True
End Sub
It sounds like a very contrived example for asking the question "In VBA, how do I fill an Excel cell with a specific string?"
The answer to that question is:
myRange.Value = "<myString>"
Anyway, this is how I would try to tackle your problem:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngChange As Range
Dim rngIntersect As Range
Dim xlCell As Range
Dim inOut As String
Set rngChange = Range("A:A")
Set rngIntersect = Intersect(Target, rngChange)
If Not rngIntersect Is Nothing Then
Application.EnableEvents = False
For Each xlCell In rngIntersect
If xlCell.Value = "" Then
inOut = "OUT"
Else
inOut = "IN"
End If
xlCell.Offset(0, 1).Value = Now
xlCell.Offset(0, 2).Value = inOut
Next xlCell
Application.EnableEvents = True
End If
End Sub
Edit:
In response to the asker's comments, the following modified code should address the problem:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngChange As Range
Dim rngIntersect As Range
Dim inOut As String
Set rngChange = Range("A:A")
Set rngIntersect = Intersect(Target, rngChange)
If Not rngIntersect Is Nothing Then
Application.EnableEvents = False
If rngIntersect.Row = 1 Then
inOut = "OUT"
ElseIf rngIntersect.Offset(-1, 2).Value = "OUT" Then
inOut = "IN"
Else
inOut = "OUT"
End If
rngIntersect.Offset(0, 1).Value = Now
rngIntersect.Offset(0, 2).Value = inOut
Application.EnableEvents = True
End If
End Sub
Edit2:
Use this to loop backwards through your log to determine the previous bookiung status for a specific id:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngChange As Range
Dim rngIntersect As Range
Dim xlCell As Range
Dim scanId As String
Dim inOutOld As String
Dim inOut As String
Set rngChange = Range("A:A")
Set rngIntersect = Intersect(Target, rngChange)
If Not rngIntersect Is Nothing Then
Application.EnableEvents = False
scanId = rngIntersect.Value
Set xlCell = rngIntersect
If rngIntersect.Row = 1 Then
inOut = "OUT"
Else
Do Until xlCell.Row = 1
Set xlCell = xlCell.Offset(-1, 0)
If xlCell.Value = scanId Then
inOutOld = xlCell.Offset(0, 2).Value
Exit Do
End If
Loop
End If
If inOutOld = "IN" Then
inOut = "OUT"
Else
inOut = "IN"
End If
rngIntersect.Offset(0, 1).Value = Now
rngIntersect.Offset(0, 2).Value = inOut
Application.EnableEvents = True
End If
End Sub
Instead of using VBA, you could do this with a worksheet 'IF()' formula.
=IF(A3="","","OUT")
=IF(A4="","","IN")
To break it down, this means that if cell A3 = nothing ("") then put nothing ("") in cell C3, but if there is something in cell A3, then put "OUT".
Place the first formula in cell C3 and the second one in C4. If the user of the tool inputs their initials/name in cell A3 then cell C3 will say OUT. It's not until the user comes back and returns the tool and enters their initials/name in cell A4 that cell C4 will say IN.
Hope this simple, non-VBA, example helps!