How do I change the text of a cell without changing the formula? - vba

I am new to VBA. This question has been asked and answered here but the answer seems way too hackish. Is there a better way to change the value of a cell without changing the underlying formula in it? I've tried target.text="changed" but that gives me an error of "Object Required"
The reason I ask is that in a UDF you can change the display of the cell but the formula remains there. How can I do this outside of a UDF?
EDIT:
In the example below, myudf and my_udf appear to do the same thing and everyone is telling me to just do NumberFormat. The problem is that Numberformat will change the cell permanently. If you entered "=my_udf()" in A2 then just go back and type some random text there. Unless you go back and manually re-format the cell (or enter in an excel built-in function), it will display "ThisThatThere".
Module1
Function myudf()
myudf = "ThisThatThere"
End Function
Function my_udf()
my_udf = "Temporary"
End Function
ThisWorkBook:
Sub Workbook_SheetChange(ByVal sh As Object, ByVal target As Range)
If target.HasFormula Then
If LCase(target.Formula) Like "=my_udf(*" Then
target.NumberFormat = "0;0;0;""ThisThatThere"""
End If
End If
End Sub

It is easy if the formula returns a number value rather than a text value .Place a formula in a cell, select it and run:
Sub ChangeText()
Dim DQ As String, mesage As String
DQ = Chr(34)
mesage = DQ & "override" & DQ
ActiveCell.NumberFormat = mesage & ";" & mesage & ";" & mesage & ";"
End Sub
By itself, a UDF , like a non-VBA worksheet formula, can only return a value to a cell.................the best the value can do it to affect conditional formatting.

Related

Turn String Into Hyperlink with Preset Name in Excel with VBA

I have a userform where I will be wanting people to enter a link e.g. bbc.com & I want the program to automatically turn this string into a hyperlink (blue underlined) called "website".
Here's what I have so far.
PublicProperty Get Link() as string
Link=Me.Linkbvalue
.cells(blankrow,1).value=me.link
EDIT: Note, words generic to protect company. Actually the problem is not it starting with local server. In the following the file is in the folder but not the subfolder
Entry="\directory\folders_directory\folder\file"
when running code,
address becomes
\directory/folders_directory\folder\sub_folder"\directory\folders_directory\folder\file"
The following might help.
It will convert column A values to hyperlinks.
Sub GetHyperlink()
For Each xCell In Range("A:A")
If xCell.Value <> "" Then
ActiveSheet.Hyperlinks.Add Anchor:=xCell, Address:="http://www." & Replace(xCell.Formula, "www.", ""), TextToDisplay:="Website"
End If
Next xCell
End Sub
This is something that should work, if you read the the entry variable from the Form:
Sub TestMe()
Dim entry As String
entry = "bbc.com"
Dim httpPrefix As String
httpPrefix = "https://"
If Left(entry, Len(httpPrefix)) <> httpPrefix Then
entry = httpPrefix & entry
End If
With Worksheets(1)
.Hyperlinks.Add Anchor:=.Cells(1, 1), _
Address:=entry, _
TextToDisplay:="website"
End With
End Sub
Some business logic is needed to decide whether to write https:// or http:// or anything similar. You may consider using Trim() to remove possible empty cells from the left and the right.

Insert Array formula in Excel VBA

I recorded the array formula in order to put in VBA. Here is what I have after the recording. However, when I run the Macro, it just doesn't work.
Will it be because of the negative sign?
From Macro
Range("D3").FormulaArray = "=IFERROR(INDEX('RMS
Maint'!R1C[-2]:R3542C[-2],SMALL(IF(('RMS Maint'!R2C27:R3542C27=R1C2)*('RMS
Maint'!R2C13:R3542C13=R2C4)*('RMS Maint'!R2C21:R3542C21=""Late"")*ROW('RMS
Maint'!R2C1:R3542C1)=0,"""",('RMS Maint'!R2C27:R3542C27=R1C2)*('RMS
Maint'!R2C13:R3542C13=R2C4)*('RMS Maint'!R2C21:R3542C21=""Late"")*ROW('RMS
Maint'!R2C1:R3542C1)),ROW('RMS Maint'!R[-2]:R[3538])),1),"""")"
From Excel formula
=IFERROR(INDEX('RMS Maint'!C$1:C$3542,SMALL(IF(('RMS
Maint'!$AA$2:$AA$3542=$B$1)*('RMS Maint'!$M$2:$M$3542=$D$2)*('RMS
Maint'!$U$2:$U$3542="Late")*ROW('RMS Maint'!$A$2:$A$3542)=0,"",('RMS
Maint'!$AA$2:$AA$3542=$B$1)*('RMS Maint'!$M$2:$M$3542=$D$2)*('RMS
Maint'!$U$2:$U$3542="Late")*ROW('RMS Maint'!$A$2:$A$3542)),ROW('RMS
Maint'!1:3541)),1),"")
The error is 1004 - Unable to set the FormulaArray property of the Range class
I'm sorry for the code format. It looked terrible.
Or you may break the long formula into few parts and replace it in the end with the actual formula like below...
Dim LogicalTest As String, FalseValue As String
LogicalTest = "('RMS Maint'!$AA$2:$AA$3542=$B$1)*('RMS Maint'!$M$2:$M$3542=$D$2)*('RMS Maint'!$U$2:$U$3542=""Late"")*ROW('RMS Maint'!$A$2:$A$3542)=0"
FalseValue = "('RMS Maint'!$AA$2:$AA$3542=$B$1)*('RMS Maint'!$M$2:$M$3542=$D$2)*('RMS Maint'!$U$2:$U$3542=""Late"")*ROW('RMS Maint'!$A$2:$A$3542)"
Range("D3").FormulaArray = "=IFERROR(INDEX('RMS Maint'!C$1:C$3542,SMALL(IF(""LogicalTest"","""",""FalseValue""),ROW('RMS Maint'!1:3541)),1),"""")"
Range("D3").Replace """LogicalTest""", LogicalTest, LookAt:=xlPart
Range("D3").Replace """FalseValue""", FalseValue, LookAt:=xlPart
There is an option of last resort: Use a human.
Have the macro place the formula into the cell as a String and have the user complete the process:
Sub pinocchio()
Range("D3") = "'=1+2"
MsgBox "User: Make this into a real array formula"
End Sub

How to create a VBA formula that takes value and format from source cell

In Excel's VBA I want to create a formula which both takes the value from the source cell and the format.
Currently I have:
Function formEq(cellRefd As Range) As Variant
'thisBackCol = cellRefd.Interior.Color
'With Application.Caller
' .Interior.Color = thisBackCol
'End With
formEq = cellRefd.Value
End Function`
This returns the current value of the cell. The parts that I have commented out return a #VALUE error in the cell. When uncommented it seems the colour of the reference is saved however the Application.Caller returns a 2023 Error. Does this mean that this is not returning the required Range object?
If so how do I get the range object that refers to the cell that the function is used? [obviously in order to set the colour to the source value].
Here's one approach showing how you can still use ThisCell:
Function CopyFormat(rngFrom, rngTo)
rngTo.Interior.Color = rngFrom.Interior.Color
rngTo.Font.Color = rngFrom.Font.Color
End Function
Function formEq(cellRefd As Range) As Variant
cellRefd.Parent.Evaluate "CopyFormat(" & cellRefd.Address() & "," & _
Application.ThisCell.Address() & ")"
formEq = cellRefd.Value
End Function
This is the solution I found to the above question using Tim William's magic:
Function cq(thisCel As Range, srcCel As Range) As Variant
thisCel.Parent.Evaluate "colorEq(" & srcCel.Address(False, False) _
& "," & thisCel.Address(False, False) & ")"
cq = srcCel.Value
End Function
Sub colorEq(srcCell, destCell)
destCell.Interior.Color = srcCell.Interior.Color
End Sub
The destCell is just a cell reference to the cell in which the function is called.
The interior.color can be exchanged or added to with other formatting rules. Three extra points to note in this solution:
By keeping the value calculation in the formula this stops the possibility for circular referencing when it destCell refers to itself. If placed in the sub then it continually recalculates; and
If the format is only changed when the source value is changed, not the format as this is the only trigger for a UDF to run and thus change the format;
Application.Caller or Application.ThisCell cannot be integrated as when it refers to itself and returns a value for itself it triggers an infinite loop or "circular reference" error. If incorporated with an Address to create a string then this works though as per Tim William's answer.

Number format displayed differently in the formula bar and cell vba

I used ActiveCell.Numerformat= "(0)" . The value is displayed with brackets in the cell but the formula bar shows the value without brackets.
Because of the above problem, Instead of using Numberformat I appended the number with brackets
var= "(" & value & ")"
After writing the var to the cell it is displayed as -450 instead of (450)
Either of method does not work for me. Any help? I am confused with vba and excel formats.
Consider:
Sub Macro2()
ActiveCell.NumberFormat = """(""General"")"""
End Sub
or:
Sub Macro2()
ActiveCell.NumberFormat = """(""0"")"""
End Sub

Detect whether cell value was actually changed by editing

Worksheet_Change triggers when a cell value is changed (which is what I want), but it also triggers when you enter a cell as if to edit it but don't actually change the cell's value (and this is what I don't want to happen).
Say I want to add shading to cells whose value was changed. So I code this:
Private Sub Worksheet_Change(ByVal Target As Range)
Target.Interior.ColorIndex = 36
End Sub
Now to test my work: Change cell A1 and the cell gets highlighted. That's the desired behaviour. So far so good. Then, double click B1 but don't change the value there and then click C1. You'll notice B1 gets highlighted! And this is not the desired behaviour.
Do I have to go through the methods discussed here of capturing the old value, then compare old to new before highlighting the cell? I certainly hope there's something I'm missing.
I suggest automatically maintaining a "mirror copy" of your sheet, in another sheet, for comparison with the changed cell's value.
#brettdj and #JohnLBevan essentially propose doing the same thing, but they store cell values in comments or a dictionary, respectively (and +1 for those ideas indeed). My feeling, though, is that it is conceptually much simpler to back up cells in cells, rather than in other objects (especially comments, which you or the user may want to use for other purposes).
So, say I have Sheet1 whose cells the user may change. I created this other sheet called Sheet1_Mirror (which you could create at Workbook_Open and could set to be hidden if you so desire -- up to you). To start with, the contents of Sheet1_Mirror would be identical to that of Sheet1 (again, you could enforce this at Workbook_Open).
Every time Sheet1's Worksheet_Change is triggered, the code checks whether the "changed" cell's value in Sheet1 is actually different from that in Sheet1_Mirror. If so, it does the action you want and updates the mirror sheet. If not, then nothing.
This should put you on the right track:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range
For Each r In Target.Cells
'Has the value actually changed?
If r.Value <> Sheet1_Mirror.Range(r.Address).Value Then
'Yes it has. Do whatever needs to be done.
MsgBox "Value of cell " & r.Address & " was changed. " & vbCrLf _
& "Was: " & vbTab & Sheet1_Mirror.Range(r.Address).Value & vbCrLf _
& "Is now: " & vbTab & r.Value
'Mirror this new value.
Sheet1_Mirror.Range(r.Address).Value = r.Value
Else
'It hasn't really changed. Do nothing.
End If
Next
End Sub
This code uses Comments to store the prior value (Please note if you do need the comments for other purposes this method will remove them)
Cells that have no value have colour reset to xlNone
An intial value typed into a cell is blue (ColorIndex 34)
If the value is changed the cell goes from blue to yellow
Normal module - turn display of comments off
Sub SetCom()
Application.DisplayCommentIndicator = xlNoIndicator
End Sub
Sheet code to capture changes
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng1 As Range
Dim shCmt As Comment
For Each rng1 In Target.Cells
If Len(rng1.Value) = 0 Then
rng1.Interior.ColorIndex = xlNone
On Error Resume Next
rng1.Comment.Delete
On Error GoTo 0
Else
On Error Resume Next
Set shCmt = rng1.Comment
On Error GoTo 0
If shCmt Is Nothing Then
Set shCmt = rng1.AddComment
shCmt.Text Text:=CStr(rng1.Value)
rng1.Interior.ColorIndex = 34
Else
If shCmt.Text <> rng1.Value Then
rng1.Interior.ColorIndex = 36
shCmt.Text Text:=CStr(rng1.Value)
End If
End If
End If
Next
End Sub
Try this code. When you enter a range it stores the original cell values in a dictionary object. When the worksheet change is triggered it compares the stored values with the actuals and highlights any changes.
NB: to improve efficiency reference microsoft scripting runtime & replace the As Object with As Scripting.Dictionary and the CreateObject("Scripting.Dictionary") with New Scripting.Dictionary.
Option Explicit
Private previousRange As Object 'reference microsoft scripting runtime & use scripting.dictionary for better performance
'I've gone with late binding to avoid references from confusing the example
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cell As Variant
For Each cell In Target
If previousRange.Exists(cell.Address) Then
If previousRange.Item(cell.Address) <> cell.FormulaR1C1 Then
cell.Interior.ColorIndex = 36
End If
End If
Next
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim cell As Variant
Set previousRange = Nothing 'not really needed but I like to kill off old references
Set previousRange = CreateObject("Scripting.Dictionary")
For Each cell In Target.Cells
previousRange.Add cell.Address, cell.FormulaR1C1
Next
End Sub
ps. any vba code to update cells (even just colour) will stop excel's undo functionality from working! To get around this you can reprogram undo functionality, but it can get quite memory intensive. Sample solutions: http://www.jkp-ads.com/Articles/UndoWithVBA00.asp / http://www.j-walk.com/ss/excel/tips/tip23.htm
I know this is an old thread, but I had exactly the same problem like this "Change cell A1 and the cell gets highlighted. That's what I'd expect. Double click B1 but don't change the value there and then click C1. You'll notice B1 gets highlighted! "
I didn't wanted to highlight a cell if it was only doubleclicked without value inside.
I solved in in easy way. Maybe it help somebody in future.
I've just added this on the beggining of the event:
If Target.Value = "" Then
Exit Sub
End If
I found this other thread that provides ways to captures the old value, so you can compare it with the "new" value and if those are then simply let it do nothing.
How do I get the old value of a changed cell in Excel VBA?