Excel VBA: Copying Formula to any active cell - vba

I am new to VBA coding and hope I can get some assistance here. I am trying to create code that would do the following for ANY cell (without specifying hard coded cell ranges or references):
input a formula in the active cell
copy it (fill) down 10 rows
In an attempt to insert the formula into the ActiveCell I tried:
Sub Test()
ActiveCell.formula = "=IF(ISBLANK(C5)*ISBLANK(D5),"",IF(ISBLANK(D5),(C5),CONCATENATE(C5,"" ["", D5, ""]"")))"
End Sub
However, this produces the
1004: Application-define or object-defined error
I've tried declaring Range objects for ActiveCell but still run into errors.
Any help on this would be highly appreciated.

ActiveCell.formula = "=IF(ISBLANK(C5)*ISBLANK(D5),"""",IF(ISBLANK(D5),(C5),CONCATENATE(C5,"" ["", D5, ""]"")))"
you missed doubling up the first set of embedded quotes.

You can use following routine to copy formula from cell to VBE compatible format. See if it helps you:
Public Sub CopyExcelFormulaInVBAFormat()
Dim strFormula As String
Dim objDataObj As Object
'\Check that single cell is selected!
If Selection.Cells.Count > 1 Then
MsgBox "Select single cell only!", vbCritical
Exit Sub
End If
'Check if we are not on a blank cell!
If Len(ActiveCell.Formula) = 0 Then
MsgBox "No Formula To Copy!", vbCritical
Exit Sub
End If
'Add quotes as required in VBE
strFormula = Chr(34) & Replace(ActiveCell.Formula, Chr(34), Chr(34) & Chr(34)) & Chr(34)
'This is ClsID of MSFORMS Data Object
Set objDataObj = CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
objDataObj.SetText strFormula, 1
objDataObj.PutInClipboard
MsgBox "VBA Format formula copied to Clipboard!", vbInformation
Set objDataObj = Nothing
End Sub
After inserting this routine. You just need to enter the formula normally in the cell. Then stay on the cell and run this code and it will copy to clipboard. Go to VBE and do CTRL+V to paste the code where required.
Originally posted on:
https://chandoo.org/forum/threads/copy-formula-from-excel-to-clipboard-in-vba-compatible-format.35997/

Related

Excel VBA Formula German/French/Italian/Russian/Dutch/Foreign Function

When I add data to my workbook it is necassary to copy the formula from an earlier cell to the new cell(s).
I used the following formula to calculate my growth rate:
=WENN(ODER(K9="";L9="");"";WENNFEHLER((L9-K9)/K9;""))
Since this is very time consuming I want to improve it with a macro and have therefor written the following code:
Sub Growth()
Tabelle3.Range("O9").Formula = "=WENN(ODER(K9="";L9="");"";WENNFEHLER((L9-K9)/K9;""))"
Tabelle3.Range("O9:O14").FillDown
End Sub
However, when I want to run the code "runtime error '1004': application defined or object defined error" occours for this line:
Tabelle3.Range("O9").Formula = "=WENN(ODER(K9="";L9="");"";WENNFEHLER((L9-K9)/K9;""))"
Does anyone know why this error occurs and how I can solve it?
You have two main errors in the code - not escapting the " characters and using .Formula instead of .FormulaLocal. The " characters should be written twice to show once in a string. See this code:
Public Sub TestMe()
Debug.Print "test"""""
End Sub
It prints test"". The last " is for the end of the string. Concerning the formula, use .FormulaLocal if you want to use the German formulas and double the doublequotes:
Range("O9").FormulaLocal = "=WENN(ODER(K9="""";L9="""");"""";WENNFEHLER((L9-K9)/K9;""""))"
In general, avoid using .FormulaLocal and use .Formula, to make your VBA code compatible with a workbook from Italy or France from example. Something like this will work with any local settings in Excel:
Range("O9").Formula = "=IF(OR(K9="""",L9=""""),"""",IFERROR(((K9-K9)/K9),""""))"
What I usually do is the following:
Write the formula, so it works in Excel;
Select it manually;
Run this:
Public Sub PrintMeUsefulFormula()
Dim strFormula As String
Dim strParenth As String
strParenth = """"
strFormula = Selection.Formula
strFormula = Replace(strFormula, """", """""")
strFormula = strParenth & strFormula & strParenth
Debug.Print strFormula
End Sub
It prints the formula as it should look like in the immediate window;
Copy it;
In the code above you may replace Selection.Formula with one of the following three (Consider as an example =IF(B1=C1,""Equal"",""Not Equal"")
Selection.FormulaLocal (gets the local formula =WENN() for Germany)
=WENN(B1=C1;""Equal"";""Not equal"")
Selection.FormulaR1C1 (gets formula in R1C1 format)
=IF(RC[1]=RC[2],""Equal"",""Not equal"")
Selection.FormulaR1C1Local (gets R1C1 format with local formulas)
=WENN(ZS(1)=ZS(2);"Equal";"Not equal")

Excel Copy a range of cell values to the clipboard

I want to copy a range of cell (values only/ text) to the clipboard so the user does not have to do a paste special values only when they paste them into another spreadsheet.
Here is what I have so far:
Private Sub CommandButton1_Click()
With New DataObject
.SetText Range("A32:Q32").Text
.PutInClipboard
End With
'Range("A32:Q32").Copy
End Sub
This gives me a runtime error
94 Invalid use of Null
If I just use the commented out code Range.("A32:Q32").Copy it copies the formulas and unless the user does the special paste they get all kinds of reference errors.
It's a bit convoluted, but get text > clear clipboard > put text back :
[A32:Q32].Copy
With New DataObject
.GetFromClipboard
s = .GetText
.Clear
.SetText s
.PutInClipboard
End With
Range.Text returns Null when the individual cell texts in the range are different.
I don’t know dataobject, so I propose a workaround by having the user select the destination cell, too
Private Sub CommandButton1_Click()
Dim userRng As Range
With ActiveSheet 'reference currently active sheet, before the user could change it via inputbox
Set userRange = GetUserRange()
If Not userRange Is Nothing Then ' if the user chose a valid range
With .Range("A32:Q32")
userRange.Resize(.Rows.Count, .Columns.Count).Value =.Value ' paste values only
End With
End If
End With
End Sub
Function GetUserRange() As Range
' adapted from http://spreadsheetpage.com/index.php/tip/pausing_a_macro_to_get_a_user_selected_range/
Prompt = "Select a cell for the output."
Title = "Select a cell"
' Display the Input Box
On Error Resume Next
Set GetUserRange = Application.InputBox( _
Prompt:=Prompt, _
Title:=Title, _
Default:=ActiveCell.Address, _
Type:=8) 'Range selection
' Was the Input Box canceled?
If GetUserRange Is Nothing Then MsgBox “Canceled!”
End Function

Excel: Name sheet tab from cell value in another sheet

I can successfully name my sheet tab based on a cell reference in the same sheet with the following VBA code:
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Set Target = Range("A1")
If Target = "" Then Exit Sub
On Error GoTo Badname
ActiveSheet.Name = Left(Target, 31)
Exit Sub
Badname:
MsgBox "Please revise the entry in A1." & Chr(13) _
& "It appears to contain one or more " & Chr(13) _
& "illegal characters." & Chr(13)
Range("A1").Activate
End Sub
However, I am struggling to change the sheet tab based on a cell reference in the title sheet. I have tried simply replacing the range with the reference from the desired sheet, Range("Keywords!A1"), but this does not seem to work.
Any suggestions to get around this would be hugely appreciated.
Use this to reference another worksheet
Worksheets("Keywords").Range("A1").Value

application.run vba not working with sheet macros

My file has different sheets with the same-named sub routine inside each doing different things specific to the sheet. So, I'm trying to call dynamically a macro inside a selected sheet using Application.Run from a module. All sheets' "object" name (I don't know how to call those) are already modified to be the same as its view (inside the bracket) name, without the spaces.
macro = Chr(39) & ThisWorkbook.Name & Chr(39) & "!" & Replace(SheetName, " ", "") & "." & "Harmoniser()"
Application.Run macro
Here's an example of the Harmoniser macro in a Sheet.
Sub Harmoniser()
ActiveSheet.Range("k22").GoalSeek Goal:=0, ChangingCell:=Range("l13")
MsgBox ("Done!")
End Sub
Somehow, only the MsgBox works, and it shows it twice everytime. Debugging by putting a break point doesn't work either. It happens to all of my sheets. Is there a limitation to Application.Run that it only allows certain code or there's an error that Excel is not giving me?
I get the same thing when I run your code. I tried a few different tweaks and am able to enter debug/breakpoint mode if I do this:
Sub t()
Dim sht As Worksheet
Dim macro As String
For Each sht In ThisWorkbook.Worksheets
sht.Activate
macro = sht.CodeName & ".Harmoniser"
Application.Run macro
Next
End Sub
Your code may have been erroring silently because you were using ActiveSheet without first Activating the sheet which contains the macro to be run. Not sure about the double-display of the MsgBox, but seems like that may be related.

I'm trying to create 2 separate excel macros in one goal which is quite tough i know

1st Macro
To go to the cell reference keyed(which is akin to F5), however I'm stuck with the following;
Public Sub Cellgoto()
Application.Goto Reference:="To be input by user"
End Sub
A Separate 2nd Macro
Purpose: Once the first macro is executed, and go to the rowcolumn that I want, or the designated cell. Then I would love to have another macro to prompt user to paste formulas over to a new text/inputbox. In turn it will pasted to the designated cell(from the first macro). This is really tough, which I'm pretty stuck..
Need angels!
Here's your Macro. I just wrote the code and tested it and it works. Hope it helps!
Sub GotoCellAndEnterFormula()
Dim strGotoCell As String
Dim strFormula As String
strGotoCell = InputBox("Enter a Cell Reference (ex: B10 )", "Goto Cell")
If strGotoCell <> "" Then
Application.Goto Reference:=Range(strGotoCell)
strFormula = InputBox("Enter a Formula (ex: = SUM(A1,A2) )", "Formula Entry")
If strFormula <> "" Then
ActiveCell.Formula = strFormula
End If
End If
End Sub