Declaring an excel formula as a constant in vba - vba

I received some help on here to declare a formula as a constant in vba. I have approximately ten formulas that are all similar variations on a theme. I've set 9 of them and they work fine the below one throws up a Run-time error (Run-time error '1004'; Application-defined or object-defined error.
Option Explicit
Public Const csFORMULA = "=CONCATENATE(""AVABIS"",IF(I2=0,"""",CONCATENATE(UPPER(AlphaNumericOnly(LEFT(I2,3))),UPPER(AlphaNumericOnly(RIGHT(I2,3))))),IF(O2=0,"""",UPPER(AlphaNumericOnly(SUBSTITUTE(O2,""0"","""")))),IF(R2=0,"""",UPPER(AlphaNumericOnly(SUBSTITUTE(R2,""0"","""")))),IF(W2=0,"""",UPPER(AlphaNumericOnly(SUBSTITUTE(W2,""0"","")))),IF(AB2=0,"""",AlphaNumericOnly(SUBSTITUTE(AB2,""0"",""""))),IF(AC2=0,"""",AlphaNumericOnly(SUBSTITUTE(AC2,""0"",""""))),IF(AD2=0,"""",SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(AD2,""-"",""X""),""."",""Y""),""0"",""Z"")),IF(AF2=0,"""",SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(AF2,""-"",""X""),""."",""Y""),""0"",""Z"")),IF(AH2=0,"""",SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(AH2,""-"",""X""),""."",""Y""),""0"",""Z""))))"
Sub AvivaBIS()
Dim lr As Long
Dim cl As Range
Dim rng As Range
Dim mssg As String
Dim ws As Worksheet
Application.ScreenUpdating = False
Set ws = ActiveSheet
With ws
lr = .Range("I" & Rows.Count).End(xlUp).Row
'add the formula to generate the unique key
Range("B2:B" & lr).Formula = csFORMULA
Range("B2:B" & lr) = Range("B2:B" & lr).Value
End With
Set rng = Nothing
Set ws = Nothing
Application.ScreenUpdating = True
End Sub
I've deleted the other non-essential code from the above to simplify my question.
Steps I've taken so far:
Tried pasting the original formula straight in the sheet - this works.
Tried replacing the declared formula as something simple (e.g. A1+A2) - this works.
Double checked the quotation marks to see I have the right number - these seem fine.
Copied another very similar formula from the others I've created - this works also.
Any suggestions on what else I could look at to fix this would be gratefully received. Is there a way to get more information when it throws up a run-time error?
Thanks as always for taking the time to look.

You missed doubling up on one set of empty string double quotes (just after W2 about midway through the formula) and had an extra closing bracket at the end.
Public Const csFORMULA = "=CONCATENATE(""AVABIS"",IF(I2=0,"""",CONCATENATE(UPPER(AlphaNumericOnly(LEFT(I2,3))),UPPER(AlphaNumericOnly(RIGHT(I2,3))))),IF(O2=0,"""",UPPER(AlphaNumericOnly(SUBSTITUTE(O2,""0"","""")))),IF(R2=0,"""",UPPER(AlphaNumericOnly(SUBSTITUTE(R2,""0"","""")))),IF(W2=0,"""",UPPER(AlphaNumericOnly(SUBSTITUTE(W2,""0"","""")))),IF(AB2=0,"""",AlphaNumericOnly(SUBSTITUTE(AB2,""0"",""""))),IF(AC2=0,"""",AlphaNumericOnly(SUBSTITUTE(AC2,""0"",""""))),IF(AD2=0,"""",SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(AD2,""-"",""X""),""."",""Y""),""0"",""Z"")),IF(AF2=0,"""",SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(AF2,""-"",""X""),""."",""Y""),""0"",""Z"")),IF(AH2=0,"""",SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(AH2,""-"",""X""),""."",""Y""),""0"",""Z"")))"

Related

Ignore blanks in a range

Can some one help with the last bit of this code please, I have a range maximum ("A1:A54") when i set to this range and only (A1:A10) have a cell value which is the name of a sheet in another workbook.
This code is working but returns a
runtime 9 error
I really want to add if blank ignore if I change to range I have set to A1:A10 then no error. I think it might be there is no worksheets in the other workbook this is why I get an error on this loop.
Have looked how to ignore blanks but none of the answers i have found have worked.
I really want a if cell = "" then ignore currently I thought exit sub would work
Sub Iedextraction()
Dim wkb As Excel.Workbook, wkb1 As Excel.Workbook
Dim wks As Excel.Worksheet, wks1 As Excel.Worksheet
Dim cell As Range
Dim rng As Range
Workbooks.Open Filename:= _
"D:\Projects\ASE Templates\ASE Template White Book.xlsx"
Set wkb = Excel.Workbooks("ASE RTU Addressing with Automation.xlsm")
Set wks = wkb.Worksheets("Tab Names from White book")
Set wkb1 = Excel.Workbooks("ASE Template White Book.xlsx")
Set rng = wks.Range("A1:A54")
For Each cell In rng
wkb1.Sheets(cell.Value).Copy After:=Workbooks_
("ASE RTU Addressing with Automation.xlsm").Sheets(4)
If cell = "" Then Exit Sub
Next
' On Error GoTo 0
End Sub
Add conditional instruction:
If cl <> "" Then wkb1.Sheets(cell.Value).Copy After:=Workbooks _
("ASE RTU Addressing with Automation.xlsm").Sheets(4)
And remove:
If cell = "" Then Exit Sub
Your error occurs most probably because you try to copy before you do the check. So, at the end, you try to get a sheet with no name. :)
It is better practice to use dynamic ranges since it's likely going to change at some point in the future. There are multiple ways of doing this, but my go to method is something like this:
Dim rn As Range
Set rn = Range(Range("A1"), Range("A1").End(xlDown))
So your issue would be resolved (assuming the blank cells are truly empty) and you will not have to test for blank cells.
Regardless, you should mark one of the above answers are correct if they fixed your issue.

Application or Object defined error in range.formula

I am trying to set a formula to certain cells. The code for setting the formula in a for loop is like this:
For i = 0 To MotorAmount
Set myCell = Range(Target.Address).Offset(i, 1)
myCell.Formula = "=IFERROR(VLOOKUP(Range(Target.Address);Database!$B$31:$G$131;2;False);0)"
Next i
However I get an application or object defined error on the line that starts with myCell.Formula. I hope someone can tell me why the error occurs and how to fix it.
PS: I use semicolons in the formula because my Excel works like that. the 'Database' is the name of another sheet I use.
PS2: The sub is placed in Sheet1 under Microsoft Excel Objects in the VBAProject.
The complete code is:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim myRange As Range
Dim myCell As Range
Dim i As Integer
Dim MotorAmount As Integer
Set myRange = Range("A68:A168")
If Not Application.Intersect(myRange, Range(Target.Address)) Is Nothing Then
If Not Range(Target.Address) = "" Then
MotorAmount = InputBox("How many motors are used in this transport?", "Amount of motors")
For i = 0 To MotorAmount
Set myCell = Range(Target.Address).Offset(i, 1)
myCell.Formula = "=IFERROR(VLOOKUP(Range(Target.Address);Database!$B$31:$G$131;2;False);0)"
Next i
End If
End If
End Sub
Your formula implementation should be:
myCell.Formula = "=IFERROR(VLOOKUP(" & Target.Address & ",Database!$B$31:$G$131,2,False),0)"
Note: In VBA use commas while writing formula, in native it will automatically show the correct argument separator you are using.
You can't put code inside a formula and you should be using commas not semicolons in the formula as VBA is US-centric. I'd suggest using R1C1 references:
myCell.FormulaR1C1 = "=IFERROR(VLOOKUP(R" & Target.Row & "C1,Database!R31C2:R131C7,2,False),0)"

VBA run time error 1004 in VBA, application defined or object definned error

I am getting the error raised above on a piece of code I reuse very regularly. I cannot for the life of me figure out what the issue is. The error is occur at this line:
ws4.Range("F2:F" & LastRow).Formula = "=IF(D2="", E2, D2)"
Then LastRow variable is working and ws4 is defined. I am lost.
Thanks
Try like this in an empty Excel sheet:
Option Explicit
Public Sub Test()
Dim lastRow As Long
Dim rngCell As Range
lastRow = 5
For Each rngCell In ActiveSheet.Range("F2:F" & lastRow)
rngCell.FormulaR1C1 = "=IF(1=1,2,3)"
Next rngCell
End Sub
Then try to see the differences between it and your code. It can be that you are not referring to the correct sheet or something else. The sheet can be locked as well (e.g. 1004 is for this as well). Or some cells can be locked. Thus, the looping can help you.

Trying to loops through multiple cells in VBA

I've searched online and found a few solutions, but none of them make sense to me. I'm wondering why this specifically doesn't work:
Dim rng As Range: Set rng = Range("A5:A10")
For Each cell In rng
Dim contents As String: contents = ThisWorkbook.Sheets("ROI's").Range("cell").Value
MsgBox (contents)
Next cell
(BTW this is within a larger macro which works)
It keep saying that the error is on the third line
In addition to Scott Craners answer, take the parenthesis away from around contents in MsgBox (contents), you are not placing it into a variable so it should not be enclosed.
Sub try2()
Dim rng As Range
Dim cell As Range
Dim contents As String
Dim ws As Worksheet
Set ws = Worksheets("Sheet1")
Set rng = Range("A1:A10")
For Each cell In rng
contents = ws.Range(cell.Address(0, 0)).Value
MsgBox (contents)
Next cell
End Sub
I've been practicing wtih various problems concerning VBA...the above is just a snippet synthesizing what all the fine people above me have said about making this work. My 2 cents, brackets or not around the contents variable, the result is the same.

Copying range of cells from one workbook to another yields 400 error

Okay, so I am relatively new to Excel VBA. I am trying to do something which seems quite simple to me and there are many, many examples of how to do it which I have read exhaustively but I cannot seem to get past this so...here goes.
I am trying to paste a range of cells from one worksheet to another in Excel Microsoft Office Professional Plus 2010. I think I have reduced the problem to the absolute simplest form possible to illustrate the problem. This is just a snippet. The VictimResults and TempWorksheet variables are set higher up. I didn't include the code because I thought it might confuse the articulation of the problem.
Dim SourceWorksheet As Worksheet
Dim TargetWorksheet As Worksheet
Dim SourceRange As Range
Dim TargetRange As Range
Set SourceWorksheet = VictimResults
Set TargetWorksheet = TempWorksheet
Set SourceRange = Cells(1, 1)
Set TargetRange = Cells(1, 1)
TargetWorksheet.Range(TargetRange) = SourceWorksheet.Range(SourceRange)
I have placed the variables SourceWorksheet, TargetWorksheet, SourceRange, and TargetRange in a watch and set a breakpoint at the last line and they are all valid objects (not null). When I step over the breakpoint I get a dialog box which simply says "400".
Any help is much appreciated.
---edit---
I have created this complete VBA file that replicates the problem. Thought that might help someone answer.
Option Explicit
Sub Main()
GetFirstWorksheetContainsName("Sheet1").Range(Cells(1, 1)).Value = GetFirstWorksheetContainsName("Sheet2").Range(Cells(1, 1)).Value
End Sub
Function GetFirstWorksheetContainsName(worksheetNameContains) As Worksheet
Dim m As Long
Dim result As Worksheet
m = 1
Do
If InStr(1, Sheets(m).Name, worksheetNameContains) Then
Set result = Sheets(m)
Exit Do
End If
m = m + 1
Loop Until m > ThisWorkbook.Worksheets.Count
Set GetFirstWorksheetContainsName = result
End Function
Here is something else I tried which yields something a little more verbose.
Option Explicit
Sub Main()
Sheets("Sheet1").Select
Range(Cells(1, 1)).Select
Selection.Copy
Sheets("Sheet2").Select
Range(Cells(1, 1)).Select
ActiveSheet.Paste
End Sub
It gives me a "Method 'Range' of object '_Global' failed" error when executing the first Range(Cells(1, 1)).Select line.
If you are trying to copy and paste why not use .copy and .pastespecial. They may slow down your code a little bit but as long as your aren't copying and pasting thousands of things it should be ok.
I'm not sure where the 400 is coming from, but the exception that is thrown is the same is in your verbose example (1004 - "Method 'Range' of object '_Worksheet' failed", and is thrown for the same reason.
The problem is how you're addressing the Range. Cells(1, 1) is implicitly set to the active worksheet, not whatever range you are passing it to as a parameter. Since you only need one cell, you can just use the .Cells property instead:
Sub Main()
GetFirstWorksheetContainsName("Sheet1").Cells(1, 1).Value = _
GetFirstWorksheetContainsName("Sheet2").Cells(1, 1).Value
End Sub
If you need to copy more than one cell, you'll have to either grab a reference to a worksheets instead of inlining the calls to GetFirstWorksheetContainsName if you use dynamic ranges:
Sub Main()
Dim source As Worksheet
Dim data As Range
Set source = GetFirstWorksheetContainsName("Sheet2")
Set data = source.Range("A1:B2")
GetFirstWorksheetContainsName("Sheet1").Range(data.Address).Value = data.Value
End Sub
Or hard code it:
Sub Main()
GetFirstWorksheetContainsName("Sheet1").Range("A1:B2").Value = _
GetFirstWorksheetContainsName("Sheet2").Range("A1:B2").Value
End Sub