I found a UDF that calculates the values of a cell based on their color. It worked perfectly the first time that I used it. However, now when I change the color of a cell (the color dictates if the cell has been planned or executed), in the existing workbook it does not auto-update. See code below:
Function SumByColor(CellColor As Range, rRange As Range)
Application.Volatile True
Dim cSum As Long
Dim ColIndex As Integer
Dim cl As Variant
ColIndex = CellColor.Interior.ColorIndex
For Each cl In rRange
If cl.Interior.ColorIndex = ColIndex Then
cSum = WorksheetFunction.Sum(cl, cSum)
End If
Next cl
SumByColor = cSum
End Function
I have tried Application.Volitale, but no luck. F9 works to update the cells that house the function. Though, it would be better to auto-update in case I get busy, or walk away from my WS. Any ideas?
You can create a worksheet event proc that will run when a change is recognized on the sheet:
Private Sub Worksheet_Change(ByVal Target as Range)
'Call function with appropriate variables
End Sub
Related
I'm currently in the process of solving a
type mismatch error
in a macro I'm writing, and I've written a short subroutine to drill down on the specific issue. This subroutine should loop through all of Column A, entering the numbers 1-10 in rows 1-10.
Sub looptest()
Dim rRange As Range
Dim rCell As Range
Dim i As Integer
Set rRange = ThisWorkbook.Worksheets(1).Columns(1)
i = 0
For Each rCell In rRange
If i < 10 Then
i = i + 1
rCell.Value2 = i
End If
Next rCell
End Sub
Instead this fills every cell in Column A with 1. Stepping through it in debug mode shows that instead of referencing a single cell, rCell references the entire column.
I have found that if I replace
Set rRange = ThisWorkbook.Worksheets(1).Columns(1)
with
Set rRange = ThisWorkbook.Worksheets(1).Range("A1:A100")
the macro works as intended, however I'd prefer to be able to use Columns() or something similar in my production code.
Am I using the Columns() property improperly, and if so, is there a good workaround?
Begin with these changes:
Set rRange = ThisWorkbook.Worksheets(1).Columns(1).Cells
Dim i As Long
Using the .Cells lets us loop over the cells in a column rather than columns in a worksheet.
I have the following count color code, which is working fine until the range contains blank cells, for which you have to go in the function line and press enter, then the change into different kind of blank cells it seems, as i spotted the errors and everytime i do the step, the vba code is working again. How can I either correct the vba code so I can step this manual enter process for some blank cells, or is there an code that does the manual process for a certain range automatically?
Public Function SumByColor(pRange1 As Range, pRange2 As Range) As Double
'Update 20140210
Application.Volatile
Dim rng As Range
Dim xTotal As Double
xTotal = 0
For Each rng In pRange1
If rng.Font.Color = pRange2.Font.Color Then
xTotal = xTotal + rng.Value
End If
Next
SumByColor = xTotal
End Function
Your function work for me. I don't know what settings do you have, but try mine modification:
Public Function SumByColor(pRange1 As Range, pRange2 As Range) As Double
'Update 20140210
Application.Volatile
Dim rng As Range
Dim rngSum As Range
For Each rng In pRange1
If rng.Font.Color = pRange2.Font.Color And IsNumeric(rng.Value) Then
If rngSum Is Nothing Then
Set rngSum = rng
Else
Set rngSum = Union(rngSum, rng)
End If
End If
Next
SumByColor = WorksheetFunction.Sum(rngSum)
End Function
There is issue however for both mine and your version. It won't recalculate if you change font color for any cell. You must click Calculate Now in Formulas menu.
How can I get a user-defined function to re-evaluate itself based on changed data in the spreadsheet?
I tried F9 and Shift+F9.
The only thing that seems to work is editing the cell with the function call and then pressing Enter.
You should use Application.Volatile in the top of your function:
Function doubleMe(d)
Application.Volatile
doubleMe = d * 2
End Function
It will then reevaluate whenever the workbook changes (if your calculation is set to automatic).
Some more information on the F9 keyboard shortcuts for calculation in Excel
F9 Recalculates all worksheets in all open workbooks
Shift+ F9 Recalculates the active worksheet
Ctrl+Alt+ F9 Recalculates all worksheets in all open workbooks (Full recalculation)
Shift + Ctrl+Alt+ F9 Rebuilds the dependency tree and does a full recalculation
Okay, found this one myself. You can use Ctrl+Alt+F9 to accomplish this.
If you include ALL references to the spreadsheet data in the UDF parameter list, Excel will recalculate your function whenever the referenced data changes:
Public Function doubleMe(d As Variant)
doubleMe = d * 2
End Function
You can also use Application.Volatile, but this has the disadvantage of making your UDF always recalculate - even when it does not need to because the referenced data has not changed.
Public Function doubleMe()
Application.Volatile
doubleMe = Worksheets("Fred").Range("A1") * 2
End Function
To switch to Automatic:
Application.Calculation = xlCalculationAutomatic
To switch to Manual:
Application.Calculation = xlCalculationManual
The Application.Volatile doesn't work for recalculating a formula with my own function inside. I use the following function:
Application.CalculateFull
This refreshes the calculation better than Range(A:B).Calculate:
Public Sub UpdateMyFunctions()
Dim myRange As Range
Dim rng As Range
' Assume the functions are in this range A1:B10.
Set myRange = ActiveSheet.Range("A1:B10")
For Each rng In myRange
rng.Formula = rng.Formula
Next
End Sub
I found it best to only update the calculation when a specific cell is changed. Here is an example VBA code to place in the "Worksheet" "Change" event:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("F3")) Is Nothing Then
Application.CalculateFull
End If
End Sub
Public Sub UpdateMyFunctions()
Dim myRange As Range
Dim rng As Range
'Considering The Functions are in Range A1:B10
Set myRange = ActiveSheet.Range("A1:B10")
For Each rng In myRange
rng.Formula = rng.Formula
Next
End Sub
I have a module which I use to check what color the cell contains. If the cell is red, blue or green. But when I use the function: =SumBycolor(cell with colorx;From cell:toCell) it doesn't auto update. I have to open the cell and press enter to make any updates
Anyone have some good tips for how to add auto update?
Function SumByColor(CellColor As Range, rRange As Range)
Dim cSum As Long
Dim ColIndex As Integer
ColIndex = CellColor.Interior.ColorIndex
For Each cl In rRange
If cl.Interior.ColorIndex = ColIndex Then
cSum = WorksheetFunction.Sum(cl, cSum)
End If
Next cl
SumByColor = cSum
ActiveWorkbook.RefreshAll
End Function
If your data is in sheet1 then go to event of that sheet and select Worksheet_SelectionChange and write Sheet1.Calculate. This will calculate the function when ever selection is changed. so you do not have to open the cell and press enter to make any updates. Updates will happen with change in selection.
Paste the following code in sheet code where the formula is kept
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
sheets("data").calculate
End Sub
I have a value in a cell. This value is duplicated, intentionally, in another part of the worksheet. I would like to be able to click the cell in C5 with contents 12345 and it selects the cell in A1:1600 that contains the same value. I will never have more than 2 cells with this same value in the worksheet, but the values will change.
I appreciate any help you can offer.
Thank You.
This should do the trick - I was unsure of the range you wanted to specify, so I just put it as A1:Z1600, but change it as necessary.
In VBA, paste this into your sheet's code module:
Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
Dim OriginalAddress As String
Dim ValToFind As String
Dim CurrentCell As Range
OriginalAddress = Target.Parent.Address
ValToFind = Target.Parent.Value
With Range("A1:Z1600")
Set CurrentCell = .Find(What:=ValToFind)
If OriginalAddress = CurrentCell.Address Then
.FindNext(After:=CurrentCell).Activate
Else
CurrentCell.Activate
End If
End With
End Sub
You can use the Hyperlink function to do what you wanting. But you would have to manually type out the formula for each cell that you wanted to link... Here's an example:
=HYPERLINK("[Book1]Sheet1!F2",12345)
This method is very unwieldy. The only way to do what you want in a robust fashion would be to use VBA.
Edit: I was able to duplicate the issue. The below edits seem to resolve the issue.
This VBA solution used the FindNext function to find the next value in the sheet:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim FirstAddress As String
Dim Rng As Range
Dim x As Long
x = Me.UsedRange.Rows.Count
FirstAddress = Target.Address
Set Rng = Me.UsedRange.Find(Target.Value)
If FirstAddress = Rng.Address Then
Me.UsedRange.FindNext(Rng).Select
Else
Rng.Select
End If
End Sub
This works with a double click for the sheet the code is in, and it doesn't matter where the duplicate value is in that sheet. Just place the code in your worksheet's module.
One last way to do this (although still inferior to VBA) is to insert the hyperlink:
In this example, you click on A2>go to Insert Tab>Hyperlink>Place in This Document and enter the corresponding cell. This hyperlinks cell A2 to F2 so that when A2 is selected F2 is selected.