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
Related
How do I automatically format a cell as I enter a value?
I divided the numbers into 3 categories: percentages, small numbers (-1000 - 1000), and large numbers.
I want percentages to be displayed with 2 decimals and the % sign.
Small numbers with 2 decimals as well.
And large numbers rounded to nearest integer, with thousands separators.
I want the code to reformat the cell if the cell value changes. For instance, if I change a cell with value "50,000", to 60%, then, it should be displayed as "60.00%".
Code I have so far applies formatting on existing cell values.
Sub myNumberFormat()
Dim cel As Range
Dim selectedRange As Range
Set selectedRange = Selection
For Each cel In selectedRange.Cells
If Not CStr(cel.Text) Like "*%*" Then
If Not IsEmpty(cel) Then
If cel.Value < 1000 And cel.Value > -1000 Then
cel.NumberFormat = "_(#,##0.00_);_(-#,##0.00_);_(""-""??_)"
Else
cel.NumberFormat = "_(#,##0_);_((#,##0);_(""-""??_)"
End If
End If
Else
cel.NumberFormat = "0.00%"
End If
Next cel
End Sub
A Worksheet Change: Apply Cell Formatting
This is a simple example for a single column, in this particular case, the range from A2 to the bottom-most cell in column A. But you can choose any reasonable cell address. In whatever cell you manually change (enter, copy/paste, or write using VBA) its value, the cell will be formatted according to your 'rearranged' procedure ApplyMySpecialNumberFormat.
Note that this works automatically, just copy the codes to the appropriate modules and start entering data into the cells of the range to see it work.
Sheet Module e.g. Sheet1
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
' Define constants.
Const FirstCellAddress As String = "A2" ' adjust to any reasonable cell
' Reference the source column range e.g. 'A2:ALastWorksheetRow'.
Dim srg As Range '
With Me.Range(FirstCellAddress)
Set srg = .Resize(Me.Rows.Count - .Row + 1)
End With
' Reference the cells of the source range that have changed.
Dim irg As Range: Set irg = Intersect(srg, Target)
If irg Is Nothing Then Exit Sub ' no source range cells changed; exit
' At least one cell was changed:
ApplyMySpecialNumberFormat irg
End Sub
Standard Module e.g. Module1
Option Explicit
Sub ApplyMySpecialNumberFormat(ByVal rg As Range)
Dim cel As Range
For Each cel In rg.Cells
If CStr(cel.Text) Like "*%*" Then
cel.NumberFormat = "0.00%"
Else
If VarType(cel) = vbDouble Then ' is a number
If cel.Value < 1000 And cel.Value > -1000 Then
cel.NumberFormat = "_(#,##0.00_);_(-#,##0.00_);_(""-""??_)"
Else
cel.NumberFormat = "_(#,##0_);_((#,##0);_(""-""??_)"
End If
End If
End If
Next cel
End Sub
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
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!
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
I'm looking for some help please with some VBA.
Let's say I have a range of cells (B4:B12), so if I input data in a cell within the range I would like to clear all cells in the same range except for the cell in which I inputed the data. So that I can only have 1 cell with data in the range.
So if B5 had data and I inputed data in B7 then B5 would clear, then if i entered data in B10 then B7 would clear...
I hope there is a solution as I have been trying to find an answer for the past couple of hours.
I would do it this way:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Set myRange = Sh.Range("B4:B12")
'set the current cell/address/value so we don't lose them when the range is cleared
Set cell = Sh.Range(Target.address)
value = Target
'disable/enable so this isn't called every time a cell is cleared
'clear the range then reset the to entered value
If Not Intersect(Target, myRange) Is Nothing Then
Application.EnableEvents = False
myRange.Clear
cell.value = value
Application.EnableEvents = True
End If
End Sub
Or you could use worksheet event to bevplaced in the relevant worksheet code pane
Private Sub Worksheet_Change(ByVal Target As Range)
Dim myVal As Variant
With Range("B4:B12") ‘reference your range
If Not Intersect(Target, .Cells) Is Nothing And Target.Count = 1 Then ‘ if changed range is one cell within the referenced one
myVal = Target.Value ‘store changed cell value
Application.EnableEvents = False
.ClearContents ‘ clear the content of referenced range
Target.Value = myVal ‘ write changed cell value back
Application.EnableEvents = True
End If
End With
End Sub