Am trying to run VBA on certain columns (ex: M, N, U, V...) to format the values based on their range.
I currently have:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("U:W")) Is Nothing Then
If Target.Value < -1000000 Then
Target.NumberFormat = "#,###.0,, ""M"""
ElseIf Target.Value <= -1000 Then
Target.NumberFormat = "#,###.0, ""K"""
ElseIf Target.Value < 1000 Then
Target.NumberFormat = "### """""
ElseIf Target.Value < 1000000 Then
Target.NumberFormat = "#,###.0, ""K"""
ElseIf Target.Value < 1000000000 Then
Target.NumberFormat = "#,###.0,, ""M"""
ElseIf Target.Value < 1000000000000# Then
Target.NumberFormat = "#,###.0,,, ""B"""
End If
End If
End Sub
Unfortunately, this isn't working on values already entered. However, if I click in each cell and then hit return, if formats correctly.
QUESTION: How would I go about formatting the values that are already there?
Thank you
Looks like the Target is only the range that changed:
https://msdn.microsoft.com/en-us/vba/excel-vba/articles/worksheet-change-event-excel
You'll probably have to write a sub that will loop through the other data, or just "edit" the cells once and the macro will work going forward.
EDIT:
How about looping through the columns and calling your function?:
Sub OneTimeLoop()
Dim rng as Range, cell as Range
set rng = Range("U:V")
For Each cell in rng
Worksheet_Change cell
Next cell
End Sub
I think, you need Precedents property, which will retrieve all cells a current cell is dependent upon.
Say, you have:
in A1 cell: 1
in A2 cell: =A1+1
Then the following code will show $A$1:
Sub F()
MsgBox Range("A2").Precedents(1).Address
End Sub
Related
this is the first time I am trying to use a if target.address macro.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$A$1:$A$20 Then
If Target.Value > "0" Then Range("B1:B20").Value = Date
If Target.Value <= "0" Then Range("B1:B20").Value = ""
End If
End Sub
my idea is that when I enter something in Cell A1 the date of today gets pasted in the cell B1,
Same with A2 - B2 and so on, I got it running when I only entered one Cell like A1 and B1 but I need it for multiple cells, all in Column A and B starting row 7.
Any idea how that works? Sorry I am pretty new to the topic.
best regards
Phur
That code would only work if you changed the entire range A1:A20 in one go.
If you want to check if a cell in that range has changed use Intersect and to refer to the cell in column B of the same row as the changed cell use Offset.
So something like this.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("$A$1:$A$20")) Is Nothing Then
If Target.Value > 0 Then
Target.Offset(, 1).Value = Date
ElseIf Target.Value <= 0 Then
Target.Offset(, 1).Value = ""
End If
End If
End Sub
I am trying to track data in a laboratory.
Goal. When the value in cell P3 changes to "yes", then cells Q3:AE3 are locked. However, if "yes" does not appear in cell P3, then cells Q3:AE3 are unlocked.
I need to loop through column P locking/unlocking cells with respect to the row each P value is located.
For example if P36 = "Yes", the Q36:AE36 would become locked.
Edit: This code works with line P3. How can I make this loop through P3:P500?
Private Sub Worksheet_Change(ByVal Target As Range)
If Range("P3") = "Yes" Then
Range("Q3:AE3").Locked = True
ElseIf Range("P3") = "No" Then
Range("Q3:AE3").Locked = False
ElseIf Range("P3") = "" Then
Range("Q3:AE3").Locked = False
End If
End Sub
This will handle any number of values being changed in column P. Provide your password as needed.
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
'did any cells in column P change
If Not Intersect(Target, Me.Range("P1").EntireColumn) Is Nothing Then
Me.Unprotect "password"
Dim cell As Range
For Each cell In Intersect(Target, Me.Range("P1").EntireColumn)
Me.Range("Q" & cell.Row & ":AE" & cell.Row).Locked = UCase$(cell.Value) = "YES"
Next
Me.Protect "password"
End If
End Sub
I'm currently working on a sheet that has to automatically insert todays date in a cell, if another cell is = "Yes"
I currently have this line of code (that I found online):
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cell As Range
If Not Intersect(Target, Range("G:G")) Is Nothing Then
Application.EnableEvents = False
For Each cell In Target
cell.Offset(0, 4).Value = Now
cell.Offset(0, 4).NumberFormat = "dd/mm/yyyy"
Next cell
End If
Application.EnableEvents = True
End Sub
The problem is that the updated cell in row K is being updated every time the cell is changed, and it should only be updated when the cell in row G = "Yes"
I appreciate the help :)
Your basic problem is solved easily - just add an If to check the content of the cell:
For Each cell In Target
If UCase(cell.Value2) = "YES" Then
cell.Offset(0, 4).Value = Now
cell.Offset(0, 4).NumberFormat = "dd/mm/yyyy"
Next cell
Next cell
However, your check for column 'G' is flawed. Target contains all cells that are currently modified. If the user enter something into a cell, Target will contain exactly that cell. If, however, data is for example pasted into that sheet, Target will contain all cells where data is pasted into.
Now, Intersect checks if two ranges have common cells. Your statement If Not Intersect(Target, Range("G:G")) Is Nothing will check if any of the modified cells is in column G and if yes, it will write the date into the cell that is 4 columns to the right. In the case the user enter something into a cell of column G, that's okay. But if he pastes something into, let's say, cells of columns F,G,H, the code will run for all three cells. So you should check each cell individually.
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo change_exit ' Ensure that events are re-enabled in case of error
Application.EnableEvents = False
Dim cell As Range
For Each cell In Intersect(Target, Range("G:G"))
If UCase(cell.Value2) = "YES" Then
cell.Offset(0, 4).Value = Now
cell.Offset(0, 4).NumberFormat = "dd/mm/yyyy"
end if
Next cell
change_exit:
Application.EnableEvents = True
End Sub
Update: Changed the logic by just looping over the cells of target that intersect with column G - thanks to BigBen for the hint.
Consider:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cell As Range
If Not Intersect(Target, Range("G:G")) Is Nothing Then
Application.EnableEvents = False
For Each cell In Target
If cell.Value = "Yes" Then
cell.Offset(0, 4).Value = Now
cell.Offset(0, 4).NumberFormat = "dd/mm/yyyy"
End If
Next cell
End If
Application.EnableEvents = True
End Sub
We test the value of each entry!
Selection based on a range of values in each row
To: Stack overflow
1) I wish to draft a code that allows a value to be selected based on a range of values in each row as indicated in the picture.
My preliminary code below is:-
Private SubWorksheet_SelectionChange(ByVal Target As Range)
If Target.Cells.CountLarge <> 1 Then Exit Sub
If Not Intersect(Target, Me.Range("F7,H7,J7")) Is Nothing Then Me.Range("C7").Value = Target.Value
End If
If Not Intersect(Target, Me.Range("F8, H8, J8")) Is Nothing Then Me.Range("C8").Value = Target.Value End If
If Not Intersect(Target, Me.Range("F9, H9, J9, L9")) Is Nothing Then Me.Range("C9").Value = Target.Value
End If
End Sub
2) Because I have more than 100 rows of selections to be input, the said code on the above will be tediously wordy.
3) I would appreciate it if you could advise me how to refine and make it beautiful. Thank you very much.
From LC Tan 2020-01-16
If I understand correctly, whenever column F, H or J is selected, you want the value of the selected cell to be copied to column C on the same row.
This can be done in a number of ways, but here is a simple example that tests if the selected column is between 6 and 15 (F and O, can be changed), and then tests if the value in the target is a number (the count). It then copies the current cell to column C on the same row as the selected cell.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Cells.CountLarge <> 1 Then Exit Sub
If Target.Column < 6 Or Target.Column > 15 Then Exit Sub
If Not IsNumeric(Target) Then Range("C" & Target.Row).Value = Target.Value
End Sub
There are a fair few other ways to do it, but this should get you well on your way.
I have 12 sheets for 12 months with random monthly dates to manually enter in column A. Let's take the month of January as an example:
When I enter the number 25 in cell A1, I'd like the cell to automatically return 25/01/2019 in A1 (!) (or 01/25/2019, as you like). Excel autofill features can't do that to my knowledge even with custom settings, so I guess : VBA ?
I think the code should look something like this (with change event):
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range, cell As Range
Set rng = Range("A:A")
If Not Application.Intersect(rng, Range(Target.Address)) _
Is Nothing Then
'???
'If cell entered in range is a number Then
'change value to "number" & "/01/2019"
End If
End Sub
That's where I am at. I'm pretty sure this could be a useful piece of code for people working with month and entering many dates. I'm I far from the truth ? Is it even do-able ? I understand it might be more complicated than it sounds.
Try
If Target.value2 > 0 and Target.value2 <= 31 Then
Target.Value2 = dateSerial(year(now), month(now), Target.Value2)
End If
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim AffectedRange As Range
Set AffectedRange = Application.Intersect(Me.Range("A:A"), Target)
If Not AffectedRange Is Nothing Then
Dim Cell As Range
For Each Cell In AffectedRange.Cells
If Cell.Value >= 1 And Cell.Value <= 31 Then
Application.EnableEvents = False
Cell.Value = DateSerial(2019, 1, Cell.Value)
Cell.NumberFormat = "YYYY-MM-DD"
Application.EnableEvents = True
End If
Next Cell
End If
End Sub