I found this which was a good starting point, but I'm in an INDIRECT situation that I can't keep conditional formatting with the sheet because the table/sheet is repeatedly deleted/updated.
Table has a column to have 30 day old+ highlighted red.
The conditional formatting would be =J2<TODAY()-30, (anything 30 days or more would be red)
I tried the code, and it highlighted cells, but I have to click in + enter to activate.
I'm trying to get it as a module to call from a user button but spent the past few days trying and I can't figure it out
The INDIRECT feature would be sheet name: owssvr
Range: J2:J1000
Private Sub Worksheet_Change(ByVal Target As Range)
Dim icolor As Integer
Dim cell As Range
If Intersect(Target, Range("J2:J1000")) Is Nothing Then Exit Sub
For Each cell In Target
icolor = 0
Select Case cell
Case Is <= Date + 30: icolor = 3
End Select
If icolor <> 0 Then cell.Interior.ColorIndex = icolor
Next cell
End Sub
Thank you in advance.
Wasn't a VBA fix but a workaround.
Name Range the column, "PaintRed" or etc, conditional format
Apply to "PaintRed"
Sounds like it's time to play dirty...
...by forcing an update:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim icolor As Integer
Dim cell As Range
If Intersect(Target, Range("J2:J1000")) Is Nothing Then Exit Sub
For Each cell In Target
icolor = 0
Select Case cell
Case Is <= Date + 30: icolor = 3
End Select
If icolor <> 0 Then cell.Interior.ColorIndex = icolor
''' Force update here (Note: This might not be ideal and change to suit your needs.)'''
cell.Dirty
Next cell
End Sub
Related
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
I have this function where anytime a cell inside the specific range changes, calls a function.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A1:L60")) Is Nothing Then
Call fit_text
End If
End Sub
The function fit_text changes the font size of the value of the active cell.
Sub fit_text()
MsgBox ActiveCell.Characters.Count
If ActiveCell.Characters.Count > 100 Then
ActiveCell.Font.Size = 8
Else
ActiveCell.Font.Size = 10
End If
End Sub
PROBLEM: whenever I change the value of a cell where the character count is bigger then 100, the font size remains 10 and the message box that tells the value of the count shows 0, but whenever I run it on vba the message box shows the correct value and changes the font size if the count is bigger then 100. I need it to be automatic. Can´t change the height or the width of the cells
Note that Excel can automatically shrink the font size to fit into the cell. Therefore select your cell, press Ctrl+1 go to the Alignment tab and select Shrink To Fit.
To fix your code:
Don't use ActiveCell. Use Target or the Intersect range instead. The ActiveCell might not be the cell that was changed. And also Target can be multiple cells so you need to loop through all the changed cells and test each cell individually.
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim AffectedRange As Range
Set AffectedRange = Intersect(Target, Target.Parent.Range("A1:L60"))
If Not AffectedRange Is Nothing Then
Dim Cell As Range
For Each Cell In AffectedRange 'loop through all changed cells
MsgBox Len(Cell.Value)
If Len(Cell.Value) > 100 Then
Cell.Font.Size = 8
Else
Cell.Font.Size = 10
End If
Next Cell
End If
End Sub
ActiveCell is the one active after the Change event. You can pass Target from the event to your method fit_text, so that it will always refer to the changed cells:
Private Sub Worksheet_Change(ByVal target As Range)
If Not Intersect(target, Range("A1:L60")) Is Nothing Then
Call fit_text(target)
End If
End Sub
Sub fit_text(target As Range)
MsgBox ActiveCell.Address(False, False)
MsgBox target.Characters.Count
' If ActiveCell.Characters.Count > 100 Then
' ActiveCell.Font.Size = 8
' Else
' ActiveCell.Font.Size = 10
' End If
If target.Characters.Count > 100 Then
target.Font.Size = 8
Else
target.Font.Size = 10
End If
End Sub
You will also want to include a check for when Target is more than a single cell; in which case you will probably want your procedure to check each cell's content.
The problem is the 'ActiveCell'.
For example when you edit the Cell A1 and press enter, the ActiveCell you are using in fit_text is not A1, but A2.
This however can easily fixed, by just passing the Cell from the Worksheet_Change to fit_text.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A1:L60")) Is Nothing Then
'Pass the Target to 'fit_text'
Call fit_text(Target)
End If
End Sub
Sub fit_text(Cell)
'Instead of using ActiveCell, use Cell (which is the passed Target)
MsgBox Cell.Characters.Count
If Cell.Characters.Count > 100 Then
Cell.Font.Size = 8
Else
Cell.Font.Size = 10
End If
End Sub
I want a worksheet change macro, that pops up a Messagebox whenever a value higher than 8 is put in one of the cells in range (F14:J26) and if a value greater than 300 is put in cell C37.
My problem is that cell C37 is not filled out manually but has a formula in it so it is a calculation of two other cells. And I think excel doesn't recognize this as a value and therefore doesn't do anything whenever the result in that cell is higher than 300.
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Target, Range("F14:J26")) Is Nothing Then
If Target.Value > 8 Then
MsgBox "Was that accepted?"
End If
End If
If Not Application.Intersect(Target, Range("C37")) Is Nothing Then
If Target.Value > 300 Then
MsgBox "Was that accepted?"
End If
End If
End Sub
The first part of the code works as it should. But the second part as explained above doesn't. I also tried to split it in two separate codes but that shows a bug. Any help on this would be very much appreciated!
In addition to Gerrit's anwser I recommend to extend it in the following way, so it doesn't fail if someone pastes a data range into F14:J26.
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim AffectedRng As Range
Set AffectedRng = Application.Intersect(Target, Range("F14:J26"))
Dim FoundInvalidData As Boolean
If Target.Parent.Range("C37").Value > 300 Then
FoundInvalidData = True
ElseIf Not AffectedRng Is Nothing Then
Dim Cel As Range
For Each Cel In AffectedRng.Cells
If Cel.Value > 8 Then
FoundInvalidData = True
Exit For
End If
Next Cel
End If
If FoundInvalidData Then
MsgBox "Was that accepted?"
End If
End Sub
You have two (maybe more) possible options:
Use the "Worksheet_Calculate"-event, instead of the "Worksheet_Change"-event.
If the formular in C37 is fixed, don't monitor C37 but the source-cells instead.
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Target, Range("F14:J26")) Is Nothing Then
If Target.Value > 8 OR Range("C37").Value > 300 Then
MsgBox "Was that accepted?"
End If
End If
End Sub
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