First question: I want to run a macro automatically when a specific cell value changes, however when the cell value changes, it doesn't run. The only way it runs is when I go to the "Macros" section under the developer tab and manually run the macro.
Second Question: I have a cell that is formatted as text and displays "somenumber% / someothernumber%" and I want the negative values to be colored red and the positive values to colored green. The problem is it only registers the first value, so if it's positive then all of the cell values are green, and vice versa for negative. Here is the specific text formatting: = TEXT(AS4,"[>0]+#,###0.000%;[<0]-#,###0.000%")&" "&"/"&" "&TEXT(AS6,"[>0]+#,###0.000%;[<0]-#,###0.000%").
Here is my attempt at both solutions:
Sub TextColorChange()
Dim xWs As Worksheet
Set xWs = Sheets("Trading Statistics")
For Row = 10 To 13
vall = xWs.Cells(Row, 51).Value
CheckPlus = InStr(1, vall, "+")
CheckMinus = InStr(1, vall, "-")
CheckDash = InStr(1, vall, "/")
part = Len(vall) - CheckDash + 1
If CheckMinus <> 0 Then
xWs.Cells(Row, 51).Characters(Start:=CheckMinus, Length:=part).Font.ColorIndex = 3
End If
If CheckPlus <> 0 Then
xWs.Cells(Row, 51).Characters(Start:=CheckPlus, Length:=part).Font.ColorIndex = 10
End If
Next Row
End Sub
--------------------------------
Private Sub Worksheet_Calculate()
Dim Xrg As Range
Set Xrg = Me.Range("AY6")
If Not Intersect(Xrg, Me.Range("AY6")) Is Nothing Then
Call TextColorChange
End If
End Sub
I have an excel file that does this, the code I use to active my macro when a user paste data in a sheet is:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range
Set KeyCells = Range("A2")
If Not Application.Intersect(KeyCells, Range(Target.Address)) _
Is Nothing Then
Call Sorting
Call Pic
End If
MsgBox "Data updated"
End Sub
Sorting and Pic are the macros being called and the above code has to be put in the actual sheet where the macro should trigger (i.e not in the module)
EDIT: this answers your first question. Please mark it as helpful if it was, then post your second question in a new post altogether.
Related
I am not sure whether this is running, has errors, or whether the variables are correct. I followed steps online to check what my variables are, like typing ?variable in the immediate window, checking the locals window, and hovering my mouse over the variable, but nothing comes up.
Nothing happens regardless when I go back to the workbook.
Here's a screenshot:
Included a screenshot because the problem might not be just with the code.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.address = "C5:I5" Then
Dim row As Integer
row = Application.WorksheetFunction.Match(ActiveCell.Offset(0, -1).Value, Range("$n$1:$n$365"), 0)
Dim address As Long
address = Application.WorksheetFunction.address(row, 15)
Range(address).Value = Range(address).Value + 1
ActiveCell.Value = Range(address).Value
End If
End Sub
The purpose is to add 1 to the value of the active cell when clicked. The cell's value will change based on the date in the cell directly above it; the value needs to be tied to the date. I plan to accomplish this using a hidden array of ascending dates and values, located at n1:o365.
(a) Probably your intention is to check if the target cell is within the range "C5:I5" - what your checking is if target has the address "C5:I5" so the if fails.
Use for example the function Intersect for that
(b) (Minor thing) Declare row as Long
(c) There is no .WorksheetFunction.address function. A Range has an Address property, eg Target.Address. Note that this will return a String, not a Long. But you don't need this anyhow. Use Cells if you know row and column of a cell.
Note that I haven't checked your logic to find the correct row.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, Range("C5:I5")) Is Nothing Then Exit Sub
Dim row As Long
On Error Resume Next
row = Application.WorksheetFunction.Match(Target.Offset(0, -1).Value, Range("$n$1:$n$365"), 0)
On Error GoTo 0
If row = 0 Then Exit Sub ' Row not found
Dim cell As Range
Set cell = Cells(row, 15)
cell.Value = cell.Value + 1
Target.Value = cell.Value
End Sub
My main goal is to be able to autofilter merged cells in one column.In the picture below I want row 7-9 to disappear when I remove "6" from the autofilter menu. But as I have figured, I need the value "6" to be held in all the cells "L7:L9" in order for Excel to do so.
The number 6 is calculated by adding "Num1" and "Num2" (2 * 3) by the following function I have placed in "L7":
Function Exposure(arg1 As Range, arg2 As Range) As Variant
Application.EnableEvents = False
Application.Calculation = xlManual
If Application.ThisCell.Offset(, -1).Value <> "-" And Application.ThisCell.Offset(, -2).Value <> "-" Then
Exposure = Left(Application.ThisCell.Offset(, -1).Value, 1) * Left(Application.ThisCell.Offset(, -2).Value, 1)
End If
If Exposure = 0 Then Exposure = "-"
Application.Calculation = xlAutomatic
Application.EnableEvents = True
End Function
I put the following formula inside the merged cell "L7":=Exposure(K7;J7). Then formula is dragged down."Num1" and "Num2" are controlled by valdiation fields, drop-down menu.
My plan was to unmerge after calculating the Exposure Variant, fill the same value in the remaining rows, then re-merge the same area. So I wrote this stand alone Sub:
Sub WorkingSub(rng As Range)
'Set rng = ActiveCell.MergeArea
rng.UnMerge
For i = 2 To rng.Cells.Count
rng.Cells(i).Value = rng.Cells(1).Value 'This line triggers recursion
Next i
rng.Offset(rng.Cells.Count).Copy 'Copies format from below
rng.PasteSpecial Paste:=xlPasteFormats 'Paste that keeps the values even after merging
End Sub
Which works on its own, but not when called inside the function above. After setting the first value, the function triggers "something", debug show the the function starting over, skipping the rng.PasteSpecial Paste:=xlPasteFormats code.
So my question to you guys is how do i write my function(s) to stop "recursing" and let me unmerge during the function call?
Or am I attacking this the wrong way? What would you do?
I am stuck with merged cells for lots of reasons, this is just one part of many inside this spreadsheet.
An interesting problem. You can capture the filter event through trapping a change in a calculation and then processing the rows of the table for visibility. I've made some assumptions for the initial table range assignment which may need some alteration.
The If Not VisRange Is Nothing Then is actually redundant as the prior line will throw a fit if an empty range is assigned, but I just kept it in. In order to get around having a null range, keep the header range in the initial MergedTableRange so there will always be a row visible
Within a cell either somewhere in the same worksheet or a 'dummy' worksheet
=SUBTOTAL(103,Sheet1!A3:H10) 'Or other table range
In the worksheet module code
Private Sub Worksheet_Calculate()
Dim ws As Worksheet: Set ws = Worksheets("Sheet1")
Dim MergedTableRange As Range: Set MergedTableRange = ws.Range("A2").CurrentRegion
Dim Cell As Range
Dim VisRange As Range: Set VisRange = MergedTableRange.SpecialCells(xlCellTypeVisible)
If Not VisRange Is Nothing Then
For Each Cell In VisRange
If Not Application.Intersect(Cell.MergeArea, VisRange).Address = Cell.MergeArea.Address Then
Cell.Rows.Hidden = True
End If
Next Cell
End If
End Sub
I came up with a different approach. Maybe there's a downside I'm missing. But my few test runs have succeeded.
I allready have a hidden sheet named "Template" where the formats for each new "#" is stored. So whenever the user wants to insert a new row, the template have the merged and the non-merged cells ready and insert is done through copy paste.
In that same sheet I made 2 merged rows in column 2, 3 merged cells in column 3 and so on:
This way I'm able to copy the correct number of merged rows to paste after filling the unmerged rows with their correct values.
I came to the conclusion that I could catch a Worksheet_change on the "Num1" and "Num2" columns instead of catching and canceling an autofilter call.
So I added:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Target.Worksheet.Range("J:J")) Is Nothing Then
Call UnMergeMerge(Cells(Target.Row, "L").MergeArea)
End If
If Not Intersect(Target, Target.Worksheet.Range("K:K")) Is Nothing Then
Call UnMergeMerge(Cells(Target.Row, "L").MergeArea)
End If
End Sub
And the UnMergeMerge sub ended up being:
Sub UnMergeMerge(rng As Range)
Application.EnableEvents = False
Application.ScreenUpdating = False
rng.UnMerge
For i = 2 To rng.Cells.Count
rng.Cells(i).Value = rng.Cells(1).Value
Next i
With Sheets("Template")
.Range(.Cells(8, rng.Cells.Count), .Cells(8 + rng.Cells.Count, rng.Cells.Count)).Copy
End With
rng.PasteSpecial Paste:=xlPasteFormats
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Still not sure it's the fastest and best approach...Do you guys still believe catching, undoing and running a different autofilter would be more effective?
My idea was to get an alert every time I digit the word "high" in a cell of column A (also if the word is contained in a longer string). This alert should pop up just if i edit a cell and my text contains "high" and I confirm (the alert shows when I press "enter" on the cell to confirm or just leave the edited cell). So I made this code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not IsError(Application.Match("*high*", Range("A:A"), 0)) Then
MsgBox ("Please check 2020 assessment")
End If
End Sub
The code seemed working fine. I digit "high" in a cell of column A and get the alert when I confirm- leave the cell.
The problem is that when i have a single "high" cell, the alert continues to pop up at every modification I do, in every cell. So is impossible to work on the sheet.
I need a code to make sure that, after digiting "high", i get the alert just one time, and then I do not get others when editing any cell, unless i digit "high" in another cell, or i go and modify a cell that already contains "high" and I confirm it again.
What could I do? Thanx!!
This will set a target (monitored range) and check if the first cell changed contains the word
Be aware that if you wan't to check every cell changed when you modify a range (for example when you copy and paste multiple cells), you'r have to use a loop
Private Sub Worksheet_Change(ByVal Target As Range)
' Set the range that will be monitored when changed
Dim targetRange As Range
Set targetRange = Me.Range("A:A")
' If cell changed it's not in the monitored range then exit sub
If Intersect(Target, targetRange) Is Nothing Then Exit Sub
' Check is cell contains text
If Not IsError(Application.Match("*high*", targetRange, 0)) Then
' Alert
MsgBox ("Please check 2020 assessment")
End If
End Sub
Let me know if it works
I tried your code; now, if column "A" has a cell "high", the alert correctly pop up and if then I edit cells in a column other than column "A", I don't get alert, so this is the good news!
The bad news is that if I have one single "high" in column A, when I edit any other cell in column "A" itself, I still get the alert everytime.
A Worksheet Change: Target Contains String
The message box will show only once whether you enter one ore multiple criteria values.
The Code
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Const srcCol As String = "A"
Const Criteria As String = "*high*"
Dim rng As Range: Set rng = Intersect(Columns(srcCol), Target)
If rng Is Nothing Then
Exit Sub
End If
Application.EnableEvents = False
Dim aRng As Range
Dim cel As Range
Dim foundCriteria As Boolean
For Each aRng In rng.Areas
For Each cel In aRng.Cells
If LCase(cel.Value) Like LCase(Criteria) Then
MsgBox ("Please check 2020 assessment")
foundCriteria = True
Exit For
End If
Next cel
If foundCriteria Then
Exit For
End If
Next aRng
Application.EnableEvents = True
End Sub
Sub testNonContiguous()
Range("A2,A12").Value = "high"
End Sub
I thought this was cool when I figured it out and would share.
The code removes the need to add "=" signs in front of formulas. This can give your excel sheet more of a software feel when creating templates designed for calculations to be made frequently.
In my case I have a financial analysis template that requires you have to add many items together in many different cells and much of our other templates are not excel based and do not require the "=" which causes aggravation for users switching between the two.
Private Sub Worksheet_Change(ByVal Target As Range)
'Trigger Macro
If Target.Cells.Count > 0 Then
'Define Variables
Dim rng As Range
Dim cell As Range
Dim x As String
Set rng = Target
'Add equal sign to all updated cells
On Error GoTo NoFormulas
If rng = "" Then
Exit Sub
On Error GoTo 0
ElseIf rng = Range("C2") Then
Exit Sub
Else
For Each cell In rng
On Error GoTo NoFormulas
x = cell.Formula
cell = "=" & Right(x, Len(x))
On Error GoTo 0
Next cell
Exit Sub
End If
End If
'Error Handler
NoFormulas:
Exit Sub
End Sub
Is there a simple way to do this, via macro or otherwise? By calculated field I mean a field that is computed from other fields, versus raw entered values. By highlight I mean colored differently. I need this to better understand a large spreadsheet from a client.
To do it manually, press the F5 key to bring up the GoTo dialog. Click the Special Cells button. On the next screen, select Formulas (it's an option on the right).
Excel will select all of the cells that match. Now it's just a matter of applying formatting.
I'm going to assume you're only talking about cell formulas rather than VBA calculations here, since you could set the cell colour in your VBA procedure if you're doing it that way.
The way to do this is to check the cell for a formula after you're done with it, and change it's colour at that point. The relevant event here is Change, and the cell's HasFormula property will tell you whether the cell is a literal value, or calculated from a formula:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.HasFormula Then
Target.Interior.Color = vbRed
Else
' remove background colour entirely (i.e. No Fill)
Target.Interior.ColorIndex = xlColorIndexNone
End If
End Sub
TLDR;
Use Conditional Formatting with a Formula to highlight all cells that contain a formula.
Details
In MS Office 365 Version: 5.0.4667.1002, the following works
Select a range of cells.
Case1: Use Ctrl + A to select all cells.
Case2: Select a specific range.
Go to the Home tab, Styles section, and choose Conditional Formatting > New Rule.
The "New Formatting Rule" dialog will open.
Choose "Use a formula to determine which cells to format"
In the textbox, add the following rule: =IsFormula(A1)
Case1: If you selected all cells, use A1 because it is the first cell.
Case2: If you selected a specific range, replace A1 with the first cell in your range.
Click Format...
The "Format Cells" dialog will open.
Choose the format you would like to apply. E.g. a yellow background.
Click OK.
All cells that have formulas will now have, for instance, a yellow background.
Screenshot
Excel has a built in feature of "Trace Dependents" (which shows arrows to show you the calculated cells)
Select the range containing your data.
Excel 2007 -> Formulas -> Trace Dependents
The code below should cycle through each sheet, highlighting every cells that starts with an '=' and colors it the desired color (currently colour 36 which is Light Yellow).
Sub HighLightFormulas()
Dim objSheet As Worksheet
Dim strOriginalSheet As String
Dim intMaxBlankCells As Integer
Dim intBlankColumns As Integer
Dim intBlankRows As Integer
Dim intCurrentColumn As Integer
Dim intCurrentRow As Long
intMaxBlankCells = 40
strOriginalSheet = ActiveSheet.Name
For Each objSheet In Worksheets
intBlankRows = 0
intCurrentRow = 1
intCurrentColumn = 1
Do While intCurrentRow <= 65536 And intBlankRows <= intMaxBlankCells
intBlankColumns = 0
intCurrentColumn = 1
Do While intCurrentColumn <= 256 And intBlankColumns <= intMaxBlankCells
If Left(objSheet.Cells(intCurrentRow, intCurrentColumn).Formula, 1) = '=' Then
objSheet.Cells(intCurrentRow, intCurrentColumn).Interior.ColorIndex = 36
End If
intCurrentColumn = intCurrentColumn + 1
Loop
If intCurrentColumn = intBlankColumns Then
intBlankRows = intBlankRows + 1
Else
intBlankRows = 0
End If
intCurrentRow = intCurrentRow + 1
Loop
Next objSheet
Worksheets(strOriginalSheet).Activate
Call MsgBox("The Highlighting process has completed", vbOKOnly, "Process Complete")
End Sub
It will also stop after 40 consecutive blank cells (to avoid processing all of a mostly blank sheet).
Hope this helps.
Simple solution:
Ctrl - ` (the key just above Tab)
You can use the Interior.ColorIndex property to change the active cell's background color:
ActiveCell.Interior.ColorIndex = 36
You may also apply it to a range:
Range("A1:A5").Interior.Color = RGB(200,160,35)
This applies to Excel 2003, I haven't used the latest version but I doubt this has changed.
You can usually record a macro and then look at the generated code to see how something is done.
I liked Craig's code here, because it keeps the layout of the existing worksheet and yet shows what is calculated and what is not 'at a glance', but I have reworked it a bit so it does a better job of working out the active area of sheets, and I added an 'UnhighlightFormulas' subroutine so one can easily undo the formatting (e.g. before printing). It has been tested in Excel 2007. Note that you will lose any other cell background colouring upon running this.
Option Explicit
Public Sub HighlightFormulas()
ColorFormulas (36) '36 is yellow
End Sub
Public Sub UnhighlightFormulas()
ColorFormulas (-4142) '-4142 is default
End Sub
Private Sub ColorFormulas(intColor As Integer)
Dim wshSheet As Worksheet
Dim rngRange As Range
Dim rngCell As Range
For Each wshSheet In Worksheets
Set rngRange = RangeInUse(wshSheet)
If Not rngRange Is Nothing Then
For Each rngCell In rngRange
If Left(rngCell.Formula, 1) = "=" Then
If rngCell.Interior.ColorIndex <> intColor Then rngCell.Interior.ColorIndex = intColor
Else
If rngCell.Interior.ColorIndex <> -4142 Then rngCell.Interior.ColorIndex = -4142 '-4142 is default
End If
Next
End If
Next
End Sub
Private Function RangeInUse(ws As Worksheet) As Range
Dim LastRow&, LastCol%
' adapted from http://www.beyondtechnology.com/geeks012.shtml
' Error-handling in case there is no data in worksheet
On Error Resume Next
With ws
LastRow& = .Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
LastCol% = .Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByColumns).Column
End With
Set RangeInUse = ws.Range("A1", Cells(LastRow&, LastCol%))
End Function