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
Related
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.
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
As per subject, what I need is to run macro based on other cells.
Here is the case :
cells G3 until the end of row contains data used formula =IF(B3="";"";(SUMIF('Incoming Goods'!$F$3:$F$1048576;'Current Stock'!B3;'Incoming Goods'!$M$3:$M$1048576)-(SUMIF('Outgoing Goods'!$D$4:$D$1048576;'Current Stock'!B3;'Outgoing Goods'!$J$4:$J$1048576))))--> i need to convert this formula to VBA
cells H3 should contain : If G3.value = 0 then "Out of Stock", else " "
And this sheet must be calculate every time data in G3 change automatically or any additional data on this sheet.
Already tried this code :
Private Sub Worksheet_Calculate()
Dim Current As Worksheet
Dim Rng1 As Range
Dim Target As Range
Set Current = Worksheets("Current Stock")
Set Rng1 = Current.Range("G:G")
Set Target = Range("H:H")
For Each Rng1 In Target
If Rng1.Value2 = "0" Then
Target.Value2 = "Out Of Stock"
Else
Exit Sub
End If
Next
End Sub
However, above code is Not working. Already try using Private Sub Selection Change() and Private Sub Selection Change() but still not working.
Any suggestion?
Thanks in advance
the answer to the first part is below:
ActiveCell.FormulaR1C1 = _
"=IF(R[2]C[1]="""","""",(SUMIF('Incoming Goods'!R3C6:R1048576C6,'Current Stock'!R[2]C[1],'Incoming Goods'!R3C13:R1048576C13)-(SUMIF('Outgoing Goods'!R4C4:R1048576C4,'Current Stock'!R[2]C[1],'Outgoing Goods'!R4C10:R1048576C10))))"
handy tip: to convert any excel formula to code, hit the record macro button, then click on the cell, press F2 key, then press enter, and stop recording macro. The code will now be in its own module in the vba editor.
This should do what you want.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Not Application.Intersect(Range("A1"), Target) Is Nothing Then
If IsNumeric(Target.Value) And Target.Value > 200 Then
Call YourMacroName
End If
End If
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.
I'm trying to set up Excel so that the cell's value that is selected in the first worksheet is set to the value of a cell that's double clicked in a different worksheet. So far my code looks like this:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim c As Range
For Each c In Sheet1.Range("M11:M24")
If IsEmpty(c) Then
c.Value = Target.Value
Exit For
End If
Next c
End Sub
What this does is sets the first empty cell in the range m11:m24 to the contents of the double clicked cell in the other worksheet. What I want though is not a static "M11:M24" range, but instead have the user select a cell in the first worksheet by clicking on it, move to the other worksheet, double click a cell in that worksheet and have the value appear in the selected cell on the first worksheet. I think I could have it so that there is a variable set up to save which cell is selected in the first worksheet and then just access that from the other worksheet. But I'd prefer if there was away built in to Excel to just choose the selected cell.
Is there a way to get the selected cell/range in Excel?
I solved this easily. The code is:
Sheet1.Activate
ActiveCell.Value = Target.Value
If you want to do a whole selection, try
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Sheet1.Activate
Dim r As Range
Set r = Selection
r.Value = Target.Value
End Sub