Does there exist a VBA command which does not change the formula of a cell, but its value? - vba

Suppose in a worksheet the formula of R4 cell is =B1+B2, and its current value is 10.
A VBA command Range("R4").Value = 5 will change both its formula and its value to 5.
Does anyone know if there exists a VBA command which changes the value of R4 to 5, but does not change its formula, such that its formula is still =B1+B2?
PS: we can also achieve the same state in another way: 1) do a Range("R4").Value = 5 2) change the formula of R4 to =B1+B2 but without evaluating it. In this case, does there exist a VBA command which change the formula of a cell without evaluating it?
Edit: What I want to do is...
I would like to write a function, which takes a worksheet where some cells may be out of date (the formula does not match its value), and generates automatically a VBA Sub, this VBA Sub can reproduce this worksheet. The VBA Sub may look like:
Sub Initiate()
Cells(2,3).Value = 5
Cells(4,5).Value = 10
...
Cells(2,3).Formula = "=2+3"
Cells(4,5).Formula = "=C2+C2"
...
End Sub
Such that running Initiate() builds one worksheet with same values and formulas.
Without the VBA command I am asking, this Initiate() will be hard to generated.

You cannot change the value of a cell to something different than what the cell formula computes to.
Regarding your p.s.: You can probably change the formula of a cell without re-evaluation by changing the calculation mode to manual. But that would of course apply to the entire workbook, not just this one cell
EDIT: maybe a solution would be to temporarily save the formula of the cell in either a tag of that cell, or a hidden worksheet?

It is quite simple to change the result of a formula without changing the formula itself:
Change the value of of its argument(s). This is a Solver-type approach:
Sub ForceDesiredResult()
Dim r As Range
Set r = Range("B2")
With r
If r.HasFormula Then
.Formula = .Formula & "-5"
Else
.Value = .Value - 5
End If
End With
End Sub

Here is some very dirty code that will save all values of all formulas on the active sheet as custom properties of the sheet, and a 2nd sub that will mark red all cells where the value has changed from it's original value, while preserving all formulas. It will need some error-checking routines (property already exists, property doesn't exist,...) but should give you something to work with. Since I don't really understand your problem it's a bit hard to say ;)
Sub AddCustomProperty()
Dim mysheet As Worksheet
Dim mycell2 As Range
Dim myProperty As CustomProperty
Set mysheet = ActiveWorkbook.ActiveSheet
For Each objcell In mysheet.UsedRange.Cells
Debug.Print objcell.Address
If objcell.HasFormula Then Set myProperty = mysheet.CustomProperties.Add(objcell.Address, objcell.Value)
Next objcell
End Sub
Sub CompareTags()
Dim mysheet As Worksheet
Dim mycell2 As Range
Dim myProperty As CustomProperty
Set mysheet = ActiveWorkbook.ActiveSheet
For Each objcell In mysheet.UsedRange.Cells
Debug.Print objcell.Address
If objcell.HasFormula Then
On Error Resume Next
If mysheet.CustomProperties(objcell.Address).Value <> objcell.Value Then
objcell.Font.ColorIndex = 3
On Error GoTo 0
End If
End If
Next objcell
End Sub

Related

VBA - Highlight Cell With Checkbox

Some logic to my process:
In column K on my worksheet I have inserted check boxes from cell K3 - K53 (this could become longer in the future) using the developer tab.
I then associated the check box with the same cell it is placed in.
I formatted the cells in this column by going to 'Format Cells', clicking on 'Custom' then typing in ';;;'. This was to HIDE the 'True/False' text from view.
My next step is to change the cell colour based on the text.
Note:
I have searched through a few forums and combined some code samples from them all, so I will not be able to reference the sources exactly, but below is what I have so far:
Code:
Sub Change_Cell_Colour()
Dim xName As Integer
Dim xChk As CheckBox
Dim rng As Range
Dim lRow As Long
lRow = ActiveWorksheet.Cells(Rows.Count, "B").End(xlUp).Row
Set rng = ActiveWorksheet.Range("K2:K" & lRow)
For Each xChk In ActiveSheet.CheckBoxes
xName = Right(xChk.Name, Len(xChk.Name) - 10)
If (Range(xChk.LinkedCell) = "True") Then
rng.Interior.ColorIndex = 6
Else
rng.Interior.ColorIndex = xlNone
End If
Next
End Sub
I keep getting an error on the line where I try to get the last row.
Code:
lRow = ActiveWorksheet.Cells(Rows.Count, "B").End(xlUp).Row
Error:
Object Required
I am not even sure if the code I have will solve my issue, so any help solving the main issue highlighting a cell based on the check box being checked or not, will be greatly appreciated.
Here's a quick rewrite with LOTS of comments explaining:
Sub Change_Cell_Colour()
Dim xChk As CheckBox
'Be explicit about which worksheet. Leaving it to "Activeworksheet" is going to cause problems
' as we aren't always sure which sheet is active...
'Also in this case we don't need to know the last row. We will iterate checkbox objects, not
' populate rows.
'lRow = ActiveWorksheet.Cells(Rows.Count, "B").End(xlUp).Row
'Again... we don't need this. We just need to iterate all the checkboxes on the sheet
'Set rng = ActiveWorksheet.Range("K2:K" & lRow)
'This is good stuff right here, just change the ActiveSheet to something more explicit
' I've changed this to the tab named "Sheet1" for instance.
For Each xChk In Sheets("Sheet1").CheckBoxes
'Getting the name of the checkbox (but only the last 10 characters)
xName = Right(xChk.Name, Len(xChk.Name) - 10)
'We can check the linked cell's value, but we can also just check if the
' if the checkbox is checked... wouldn't that be easier?
'If (Range(xChk.LinkedCell) = "True") Then
If xChk.Value = 1 Then
'Now we can use the "LinkedCell", but it's a STRING not a RANGE, so we will have
' to treat it as the string name of a range to use it properly
Sheets("Sheet1").Range(xChk.LinkedCell).Interior.ColorIndex = 6
Else
Sheets("Sheet1").Range(xChk.LinkedCell).Interior.ColorIndex = xlNone
End If
Next
End Sub
Here's the barebones version just to get it working
Sub Change_Cell_Colour()
Dim xChk As CheckBox
'Loop through each checkbox in Sheet1. Set it to color 6 if true, otherwise no color
For Each xChk In Sheets("Sheet1").CheckBoxes
If xChk.Value = 1 Then
Sheets("Sheet1").Range(xChk.LinkedCell).Interior.ColorIndex = 6
Else
Sheets("Sheet1").Range(xChk.LinkedCell).Interior.ColorIndex = xlNone
End If
Next
End Sub
I'm totally assuming here, but I would imagine you want this macro to fire when a checkbox is clicked. There is a handy Application.Caller that holds the name of the object that caused a macro to be called. You can set the "Assign Macro.." of each checkbox to this new code and then you can figure out which checkbox called the subroutine/macro using application.caller and follow the same logic to toggle it's linked cell color:
Sub Change_Cell_Colour()
Dim xChk As CheckBox
'Who called this subroutine/macro?
Dim clickedCheckbox As String
clickedCheckbox = Application.Caller
'Lets check just this checkbox
Set xChk = Sheets("Sheet1").CheckBoxes(clickedCheckbox)
'toggle its color or colour if you are a neighbour
If xChk.Value = 1 Then
Sheets("Sheet1").Range(xChk.LinkedCell).Interior.ColorIndex = 6
Else
Sheets("Sheet1").Range(xChk.LinkedCell).Interior.ColorIndex = xlNone
End If
End Sub
highlighting a cell based on the check box being checked or not
Select the sheet and apply a CF formula rule of:
=A1=TRUE
ActiveWorksheet doesn't exist, and because you haven't specified Option Explicit at the top of your module, VBA happily considers it an on-the-spot Variant variable.
Except, a Variant created on-the-spot doesn't have a subtype, so it's Variant/Empty.
And ActiveWorksheet.Cells being syntactically a member call, VBA understands it as such - so ActiveWorksheet must therefore be an object - but it's a Variant/Empty, hence, object required: the call is illegal unless ActiveWorksheet is an actual Worksheet object reference.
Specify Option Explicit at the top of the module. Declare all variables.
Then change ActiveWorksheet for ActiveSheet.

Excel VBA code to select all cells with data sometimes working

I once built a VBA button to automatically lock all cells with data in them. And it was working perfectly. Now I wanted to copy that button to another worksheet. So I created another button, copy and pasted the whole VBA over, then edited the worksheet names and range. And, it's only working like 5% of the time, the rest of the time, I'm getting an "Run-Time error '1004': No cells were found." I've tried a few fixed, changing Sheets to Worksheets, or adding a ", 23" to the specialcells argument. However, nothing is working right now. When I try stepping in, it sometimes say both rng and lckrng as empty, and sometimes only show lockrng as empty and not show rng at all. Problem is this used to be a working code, and now, it still works around 5% of time. Any idea why? Thank you very much!
Private Sub CommandButton1_Click()
Dim rng As Range
Dim lockrng As Range
Sheets("Uploading Checklist (M)").Unprotect Password:="signature"
Set rng = Range("A1:M14")
'Selecting hardcoded data and formulas
Set lockrng = Union(rng.SpecialCells(xlCellTypeConstants), rng.SpecialCells(xlCellTypeFormulas))
lockrng.Locked = True
Sheets("Uploading Checklist (M)").Protect Password:="signature"
End Sub
Maybe this is too simplistic, but it seems to do what you want. The animated .gif shows it working to "lock all cells with data in them". (I made the second button just for convenience). If nothing else it might be good to start from something like this that works and modify to suit your needs.
Dim cell As Range, sh As Worksheet
Sub Button4_Click()
Set sh = Worksheets("Sheet1")
sh.Unprotect Password:="s"
For Each cell In sh.UsedRange
If cell <> "" Then cell.Locked = True Else cell.Locked = False
Next
sh.Protect Password:="s"
End Sub
Sub Button5_Click()
Set sh = Worksheets("Sheet1")
sh.Unprotect Password:="s"
End Sub
The Union you are attempting will not work if either of the parameters is Nothing (i.e. you either have no constants in the range, or you have no formulas in the range).
Prior to doing the Union, you should check the parameters aren't Nothing but, once you start changing your code to do that, it would be just as simple to do the locking in two parts - so I recommend you rewrite the code as follows:
Private Sub CommandButton1_Click()
With Sheets("Uploading Checklist (M)")
.Unprotect Password:="signature"
With .Range("A1:M14")
'Lock any constants
If Not .SpecialCells(xlCellTypeConstants) Is Nothing Then
.SpecialCells(xlCellTypeConstants).Locked = True
End If
'Lock any formulas
If Not .SpecialCells(xlCellTypeFormulas) Is Nothing Then
.SpecialCells(xlCellTypeFormulas).Locked = True
End If
End With
.Protect Password:="signature"
End With
End Sub

Error 1004, Method 'Range' of object '_Worksheet' failed

I have lots of data (numbers) with heading in several worksheets that I am trying to zero. This is done on each column as follows: Taking the value of the first row in the column and subtracting this value from all rows in the column.
I have put together this code (may not be the best way, but Im new to VBA so :))
Dim ws As Worksheet
Dim Header As Range, Coldata As Range
Dim firstrow As Long
Dim cell As Range, cell2 As Range
Set ws = ActiveSheet
Set Header = ws.Range("B5:CJ5")
For Each cell In Header
If cell Is Nothing Then Exit For
firstrow = cell.Offset(2).Value
***Set Coldata = ws.Range(cell.offset(3),cell.Offset(3)).End(xlDown)***
cell.Value = 0
For Each cell2 In Coldata
cell2.Value = cell2.Value - firstrow
Next
Next
MsgBox "Done zeroing"
This sub is under the Module of the workbook I am working on. Whenever I run this sub from inside the VBA window it gives me the error I stated in the description on the Line of the code with **** around it.
When I try to run it from a workhsheet it says Cannot run the macro. The macro may not be avaiable in this worksheet or all macros may be disabled. The thing is I run another macro in the same module it works, so macros being disabled is out of the question.
What am I missing?
Thanks in advance!
Edit, I fixed it.. But running it takes SO much time? Excel freezes when I run it though?
You are over-specifying. Replace:
Set Coldata = ws.Range(cell.Offset(3)).End(xlDown)
with:
Set Coldata = cell.Offset(3).End(xlDown)
cell is fully qualified already.

Detect change from nested formulas

I have a very complex workbook with many tabs. The tabs may have either normal data or formulas in various cells. In the case of formulas, the formulas may be nested from one sheet to the next (i.e. a formula on sheet1 refers to a formula on sheet2 which in turn refers to a formula on sheet3, etc.).
I have a hidden tab that contains the following: source sheet, source range, target sheet, and target range.
A named range has been created over these 4 fields and all applicable rows.
When we wish to save data to the database, we loop through every row in the range mapping and copy the data from the source sheet/range to the target sheet/range. After this, the applicable data is serialized into XML and sent to a web service to be saved.
The problem that we wish to resolve is that we want to mark a cell on a hidden sheet when a change is made by the user to a source range. Since formulas can be nested, the Worksheet_Change event does not pick up the change.
Since a change on one sheet may affect another sheet that is not the active sheet, the Workbook_SheetChange event does not catch the change either.
Is there any way form me to catch when a sheet defined in the mapping is changed, even if it is the result of a formula change several levels deep?
Edit
Thank you for your responses. I was attempting to find the fastest and least process intensive way to determine if data changes within a monitored range. The data may consist of actual data or of nested formulas.
My research showed that I could not actually achieve this result by taking range intersections as I could not detect if the data within a monitored range was modified. This is due to the fact that the monitored range may not be on the active sheet and also may contain formulas.
I have shown the method used to actually detect a change below. If there is any feedback on a better way to achieve the same result, I would appreciated it.
Worksheet_Change event will not work if a cell value is changed by a formula, you need Worksheet_Calculate.
Check out my example workbook here.
And Here for the WebPage of example codes
There is no "easy" way to detect if a nested formula has changed when the formula being monitored is not on the active sheet. While my hope was to detect the modified range and use an intersection of ranges to set a flag, this was not possible because the Worksheet_Change event does not work on formulas and the Workbook_SheetChange event only works on the active sheet. Since my workbooks have over 20+ tabs and 20 - 30 ranges being monitored, this approach does not work. This approach was desired for speed purposes.
Instead, the workbook will need to "check" to see if the current values are the same as the last time the save to database event was called. If not, a dirty flag will be set.
The code for this approach is provided below.
An example of the mapping range is shown in the picture below though in practice there are 20-30 rows comprising this range.
There are three other sheets where Sheet3 contains actual data in A1:H1 and Sheet2 has formulas pointing to Sheet3. Sheet1 has formulas pointing to Sheet2.
As the mapping range indicates, we are looking at a range on Sheet1, even though changes may be made to Sheet3.
The code used is as provided below.
Option Explicit
Public Sub DetermineIfEditOccurred()
Dim oMappingRange As Range
Dim szSourceTab As String
Dim szSourceRange As String
Dim oSourceRange As Range
Dim szTargetTab As String
Dim szTargetRange As String
Dim oTargetRange As Range
Dim oWorksheetSource As Worksheet
Dim oWorksheetTarget As Worksheet
Dim oRangeIntersection As Range
Dim nRowCounter As Long
Dim nCellCounter As Long
Dim szSourceValue As String
Dim szTargetValue As String
Dim oCell As Range
Dim bIsDirty As Boolean
If Range(ThisWorkbook.Names("DirtyFlag")).Value = 0 Then
Set oMappingRange = Range(ThisWorkbook.Names("Mapping"))
For nRowCounter = 1 To oMappingRange.Rows.Count
szSourceTab = oMappingRange(nRowCounter, 1)
szSourceRange = oMappingRange(nRowCounter, 2)
szTargetTab = oMappingRange(nRowCounter, 3)
szTargetRange = oMappingRange(nRowCounter, 4)
Set oWorksheetSource = ThisWorkbook.Worksheets(szSourceTab)
Set oWorksheetTarget = ThisWorkbook.Worksheets(szTargetTab)
Set oSourceRange = oWorksheetSource.Range(szSourceRange)
Set oTargetRange = oWorksheetTarget.Range(szTargetRange)
nCellCounter = 1
For Each oCell In oSourceRange.Cells
szSourceValue = oCell.Value
If szSourceValue = "#NULL!" Or _
szSourceValue = "#DIV/0!" Or _
szSourceValue = "#VALUE!" Or _
szSourceValue = "#REF!" Or _
szSourceValue = "#NAME?" Or _
szSourceValue = "#NUM!" Or _
szSourceValue = "#N/A" Then
szSourceValue = ""
End If
szTargetValue = GetCellValueByPosition(oTargetRange, nCellCounter)
If szSourceValue <> szTargetValue Then
Range(ThisWorkbook.Names("DirtyFlag")).Value = 1
bIsDirty = True
Exit For
End If
nCellCounter = nCellCounter + 1
Next
If bIsDirty Then
Exit For
End If
Next
End If
End Sub
Public Function GetCellValueByPosition(oRange As Range, nPosition As Long) As String
Dim oCell As Range
Dim nCounter As Long
Dim szValue As String
nCounter = 1
For Each oCell In oRange
If nCounter = nPosition Then
szValue = oCell.Value
Exit For
End If
nCounter = nCounter + 1
Next
GetCellValueByPosition = szValue
End Function
The Workbook_SheetChange event is as follows:
Option Explicit
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Call DetermineIfEditOccurred
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Sh.Name <> "MAPPING" Then
Call DetermineIfEditOccurred
End If
End Sub

Create a Hyperlink that searches worksheet and selects cell with duplicate contents

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.