I'm getting an "application-defined or object-defined error" being thrown when I try to set a cell in my active sheet to a formula. I think its due to me trying to use the Sheets.Name function in the formula, see code below:
Public Sub getChannels()
Dim lastRow As Long
Dim i As Integer, counter As Integer
Dim rng As Range, rngB As Range, rngC As Range
Dim sht As Worksheet
Dim test As String
Set sht = Sheets("Summary Sheet - 30-07-2015")
sht.Activate
lastRow = sht.Cells(sht.Rows.Count, "B").End(xlUp).Row
For counter = 1 To lastRow Step 3
If ActiveSheet.Cells(counter, 12) = "LTE 2C" Then
ActiveSheet.Cells(counter, 16) = _
"=INDEX('LTE 2C'!C[55],MATCH(""'"" & sht.name &""'""!RC[-14],'LTE 2C'!C[-11],0))"
ActiveSheet.Cells(counter, 17) = _
"=INDEX('LTE 2C'!C[53],MATCH(""'"" & sht.name &""'""!RC[-15],'LTE 2C'!C[-12],0))"
ActiveSheet.Cells(counter, 18) = _
"=INDEX('LTE 2C'!C[55],MATCH(""'"" & sht.name &""'""!RC[-16],'LTE 2C'!C[-13],0))"
Range("P" & counter & ":R" & counter).Select
Selection.Copy
Range("P" & counter + 1 & ":P" & counter + 2).Select
ActiveSheet.Paste
End If
Next
End Sub
Am I missing something obvious?
Change your formula like this:
ActiveSheet.Cells(counter, 16) = _
"=INDEX('LTE 2C'!C[55],MATCH(" & "'" & sht.name & "'" & "!RC[-14],'LTE 2C'!C[-11],0))"
ActiveSheet.Cells(counter, 17) = _
"=INDEX('LTE 2C'!C[53],MATCH(" & "'" & sht.name & "'" & "!RC[-15],'LTE 2C'!C[-12],0))"
ActiveSheet.Cells(counter, 18) = _
"=INDEX('LTE 2C'!C[55],MATCH(" & "'" & sht.name & "'" & "!RC[-16],'LTE 2C'!C[-13],0))"
Nelly is correct, but another way to do this would be to simply remove the unnecessary extra string for each apostrophe and replace it with this:
ActiveSheet.Cells(counter, 16) = _
"=INDEX('LTE 2C'!C[55],MATCH('" & sht.name & "'!RC[-14],'LTE 2C'!C[-11],0))"
Where the apostrophes are just attached to the strings before and after. It really makes no difference, but it removes the extra (&)s.
Related
I've got the below code and it works completely fine for rows 1 - 46 on it's own populating one table. As soon as I replicate this with a second table to populate it throws Error1.
I've taken out everything below "' Second Table Entry " and works fine ... put back in and same error. On the "Home" sheet it actually populates the tables information but still throws the error which is stopping further vba from executing.
Any ideas? I've been all over google, stackoverflow, superuser and Microsoft MSDN and can't figure out where in the second bit of code is causing it to error.
EDIT: I've checked the debugger and it's highlighting the below code in the second table inserts
With Worksheets("Home")
.Hyperlinks.Add Anchor:=.Range("H" & row_ptr), _
Address:="", _
SubAddress:=AddStr, _
TextToDisplay:=Workbooks(ActiveWorkbook.Name).Worksheets("Audit_InFlight").Range("D" & i).Value
End With
Any help is greatly appreciated.
Error1
Run-time error '5': Invalid procedure call or argument
Private Sub Workbook_Open()
Dim row_ptr As Long
Dim i As Long
Dim i2 As Long
Dim rownbrMA_Inflight As Long
Dim rownbrAudit As Long
Dim CurrentWorkbook As Workbook
Dim InputWorksheet As Worksheet
Dim DataSourceWorksheet As Worksheet
Dim AuditDataSourceWorksheet As Worksheet
Set CurrentWorkbook = Workbooks(ActiveWorkbook.Name)
Set InputWorksheet = CurrentWorkbook.Sheets("Home")
Set DataSourceWorksheet = CurrentWorkbook.Sheets("MA_Inflight")
Set AuditDataSourceWorksheet = CurrentWorkbook.Sheets("Audit_InFlight")
InputWorksheet.Range("A30:M176").Clear
InputWorksheet.Range("A30:M176").ClearFormats
InputWorksheet.Range("A30:M176").Interior.Color = RGB(255, 255, 255)
rownbrMA_Inflight = DataSourceWorksheet.Range("C" & Rows.Count).End(xlUp).Row
row_ptr = 31
For i = 8 To rownbrMA_Inflight
If DataSourceWorksheet.Range("C" & i).Value = "Open" Then
InputWorksheet.Rows(row_ptr).Insert Shift:=xlDown 'CopyOrigin:=xlFormatFromLeftOrAbove
InputWorksheet.Range("A" & row_ptr).Value = DataSourceWorksheet.Range("E" & i).Value
InputWorksheet.Range("B" & row_ptr).Value = DataSourceWorksheet.Range("F" & i).Value
AddStr = "MA_Inflight!" & "$F$" & CStr(i)
ActiveWorkbook.Activate
Worksheets("Home").Activate
With Worksheets("Home")
.Hyperlinks.Add Anchor:=.Range("B" & row_ptr), _
Address:="", _
SubAddress:=AddStr, _
TextToDisplay:=Workbooks(ActiveWorkbook.Name).Worksheets("MA_Inflight").Range("F" & i).Value
End With
InputWorksheet.Range("C" & row_ptr).Value = DataSourceWorksheet.Range("I" & i).Value
InputWorksheet.Range("D" & row_ptr).Value = DataSourceWorksheet.Range("J" & i).Value
InputWorksheet.Range("E" & row_ptr).Value = DataSourceWorksheet.Range("L" & i).Value
row_ptr = row_ptr + 1
End If
Next i
'============================================================
' Second Table Entry
'============================================================
rownbrAudit = DataSourceWorksheet.Range("C" & Rows.Count).End(xlUp).Row
row_ptr = Empty
row_ptr = 31
For i = 8 To rownbrAudit
If AuditDataSourceWorksheet.Range("B" & i).Value <> "Closed" Then
InputWorksheet.Rows(row_ptr).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
InputWorksheet.Range("G" & row_ptr).Value = AuditDataSourceWorksheet.Range("B" & i).Value
InputWorksheet.Range("H" & row_ptr).Value = AuditDataSourceWorksheet.Range("D" & i).Value
'New code ---------------------------
AddStr = "Audit_InFlight!" & "$D$" & CStr(i)
ActiveWorkbook.Activate
Worksheets("Home").Activate
With Worksheets("Home")
.Hyperlinks.Add Anchor:=.Range("H" & row_ptr), _
Address:="", _
SubAddress:=AddStr, _
TextToDisplay:=Workbooks(ActiveWorkbook.Name).Worksheets("Audit_InFlight").Range("D" & i).Value
End With
'-----------------------------------
InputWorksheet.Range("I" & row_ptr).Value = AuditDataSourceWorksheet.Range("G" & i).Value
InputWorksheet.Range("J" & row_ptr).Value = AuditDataSourceWorksheet.Range("H" & i).Value
InputWorksheet.Range("K" & row_ptr).Value = AuditDataSourceWorksheet.Range("I" & i).Value
InputWorksheet.Range("L" & row_ptr).Value = AuditDataSourceWorksheet.Range("J" & i).Value
InputWorksheet.Range("M" & row_ptr).Value = AuditDataSourceWorksheet.Range("K" & i).Value
row_ptr = row_ptr + 1
End If
Next i
'RemoveBlankCells
'PURPOSE: Deletes single cells that are blank located inside a designated range
Dim rng As Range
'Store blank cells inside a variable
Set rng = InputWorksheet.Range("A30:E50").SpecialCells(xlCellTypeBlanks)
'Delete blank cells and shift upward
rng.Rows.Delete Shift:=xlShiftUp
End Sub
I am using Vlookup formula from another workbook in my code. The other workbook named as a variable TifuliWB Workbook but I keep getting an error run time error 1004. I am sure that it's such a small mistake of mine that stops the sub but I can't know what.
With MainWB.Worksheets(2)
LR = .Cells(Rows.Count, "A").End(xlUp).Row
.Range("J2:J" & LR).FormulaR1C1 = _
"=VLOOKUP(RC[-8]," '"[" & TifuliWB.Worksheets(1) & "]"'"!C1:C71,65,FALSE)"
.Range("J2:J" & LR).NumberFormat = "m/d/yyyy"
.Cells.Copy
End With
Try referencing the columns' full external address instead of concatenating in the workbook and worksheet name.
.Range("J2:J" & LR).FormulaR1C1 = _
"=VLOOKUP(RC[-8]," & TifuliWB.Worksheets(1).range("A:BS").address(1, 1, external:=true, referencestyle:=xlr1c1) & ",65,FALSE)"
'alternately in xlA1 style
.Range("J2:J" & LR).Formula = _
"=VLOOKUP(J2," & TifuliWB.Worksheets(1).range("A:BS").address(1, 1, external:=true) & ",65,FALSE)"
Your original should have used the .Name or .FullName property and there were some string concatenation issues.
.Range("J2:J" & LR).FormulaR1C1 = _
"=VLOOKUP(RC[-8], '[" & TifuliWB.fullname & "]" & TifuliWB.Worksheets(1).name & "'!C1:C71,65,FALSE)"
I'm trying to insert a formula in the Column C of Sheet2. The row number however depends on the value of pasterow. The range in the formula should be G[lastrow]:NS[lastrow] with lastrow pertaining to the last row of Sheet1.
Here is my code:
Sub try()
With Sheets("Sheet2")
pasterow = .Cells(.rows.Count, "B").End(xlUp).Offset(1, 0).Row
With Sheets("Sheet1")
lastRow = ActiveWorkbook.Worksheets("Sheet1").Range("F" & .rows.Count).End(xlUp).Row
ActiveWorkbook.Worksheets("Sheet2").Range("C" & pasterow).formula = _
"=COUNTIF(Sheet1!G & lastRow & :NS & lastRow & , ""VL"" )"
End With
End With
End Sub
I'll really appreciate if someone could point out what's wrong with my code. Thanks!
The VBA variables are inside your formula string. Compare:
ActiveWorkbook.Worksheets("Sheet2").Range("C" & pasterow).formula = "=COUNTIF(Sheet1!G" & lastrow & ":NS" & lastrow & ", ""VL"" )"
Try this..
ActiveWorkbook.Worksheets("Sheet2").Range("C" & pasterow).FormulaR1C1 = "=COUNTIF(Sheet1!C[4]:C[380],""VL"")"
May be this is what your expecting to achieve!
ActiveWorkbook.Worksheets("Sheet2").Range("C" & pasterow).Value = "=COUNTIF(Sheet1!G" & lastRow & ":NS" & lastRow & ", ""VL"" )"
Try with:
ActiveWorkbook.Worksheets("Sheet2").Range("C" & pasterow).formula = _
"=COUNTIF(Sheet1!R" & lastrow & "C7:R" & lastrow & "C383,""VL"")"
I want to use a formula in a range of cells but I get the formula in that cell and not the results of the formula.
I tried a couple of different ways.
The first script I tried entered the formula all the way down the column until the last row value: -
Dim LastRow As Long
LastRow = Cells(Rows.Count, 5).End(xlUp).Row
Range("DO22:DO" & LastRow).Formula = "IF=COUNTIF(AS22:AU" & LastRow & " ,""=Major Variance"")>0,""Major Variance"",IF(COUNTIF(AS22:AU" & LastRow & " ,""=Minor Variance"")>0,""Minor Variance"",""On Track""))"
This is the other script I tried but this puts the formula only in the first row of the range: -
Dim LastRow As Long
Dim Rng As Range
Range("DO22:DO" & LastRow).Select
For Each Rng In Range("DO22:DO" & LastRow)
ActiveCell.Formula = "IF=COUNTIF(AS22:AU" & LastRow & " ,""=Major Variance"")>0,""Major Variance"",IF(COUNTIF(AS22:AU" & LastRow & " ,""=Minor Variance"")>0,""Minor Variance"",""On Track""))"
Next Rng
Edit 1
I have made a change to the code as per someone's answer but I am now getting an run-time error 'Application-defined or object defined error.
It only seems to happen when I add the extra = in front of the If. The error appears on the line
Rng.Formula = "=IF=COUNTIF(AS22:AU" & LastRow & " ,""=Major Variance"")>0,""Major Variance"",IF(COUNTIF(AS22:AU" & LastRow & " ,""=Minor Variance"")>0,""Minor Variance"",""On Track""))"
Here is the edited script: -
Dim Rng As Range
Dim LastRow As Long
LastRow = Cells(Rows.Count, 5).End(xlUp).Row
Range("DO22:DO" & LastRow).Select
For Each Rng In Range("DO22:DO" & LastRow).Cells
Rng.Formula = "=IF=COUNTIF(AS22:AU" & LastRow & " ,""=Major Variance"")>0,""Major Variance"",IF(COUNTIF(AS22:AU" & LastRow & " ,""=Minor Variance"")>0,""Minor Variance"",""On Track""))"
Rng.Value = Rng.Value
Next Rng
You have a malformed IF function and COUNTIF function.
'target formula "=IF(COUNTIF(AS22:AU99, "Major Variance"), "Major Variance", =IF(COUNTIF(AS22:AU99, "Minor Variance"), "Minor Variance", "On Track"))
rng.Formula = "=IF(COUNTIF(AS22:AU" & lastRow & ", ""Major Variance""), ""Major Variance"", " & _
"IF(COUNTIF(AS22:AU" & lastRow & ", ""Minor Variance""), ""Minor Variance"", " & _
"""On Track""))"
rng = rng.Value
Note that if both Major Variance and Minor Variance exist, then Major Variance takes precedence.
To put this formula into each row and modify the row each time in a loop, the code would look like this.
Dim lastRow As Long, rng As Range
With Worksheets("Sheet1") '<~~ you should know what worksheet you are on!
lastRow = .Cells(Rows.Count, 5).End(xlUp).Row
For Each rng In .Range("DO22:DO" & lastRow)
rng.Formula = "=IF(COUNTIF(AS" & rng.Row & ":AU" & rng.Row & ", ""Major Variance""), ""Major Variance"", " & _
"IF(COUNTIF(AS" & rng.Row & ":AU" & rng.Row & ", ""Minor Variance""), ""Minor Variance"", " & _
"""On Track""))"
rng.Value = rng.Value
Next rng
End With
But you can also put the formula into all of the cells at once like this.
Dim lastRow As Long
With Worksheets("Sheet1") '<~~ you should know what worksheet you are on!
lastRow = .Cells(Rows.Count, 5).End(xlUp).Row
With .Range("DO22:DO" & lastRow)
.Formula = "=IF(COUNTIF(AS22:AU22, ""Major Variance""), ""Major Variance"", " & _
"IF(COUNTIF(AS22:AU22, ""Minor Variance""), ""Minor Variance"", " & _
"""On Track""))"
.Value = .Value
End With
End With
You are using activecell in the 2nd one so it will only be in the active cell if not selected. so you need to change your loop to be
For Each Rng In Range("DO22:DO" & LastRow).cells
and then
rng.Formula = "=IF=COUNTIF(AS22:AU" & LastRow & " ,""=Major Variance"")....
then
rng.value=rng.value
also, in the 2nd one, youre not setting LastRow.
I'm having an issue that I am struggling to solve as it's a bit specific. I have code that does copy and paste from one sheet to others. Each part of the code basically copies part from the master sheet "current" to the specified sheet.
When I run my code I receive an error "Application defined or object defined error" and the code stops at the work sheet "Dividend yield" after the following line
Worksheets("div. yield").Range("B7").Select
However if I open the sheet "Dividend yield" and run my code from there it will work fine until the last sheet "Reverse PE" where it will again throw and error "Application defined or object defined error" after the line
Worksheets("Reverse_PE").Range("B9").Select
I guess the error is related to the next coming rows with Autofill method but I have not found any useful solutions to this problem. Could somebody please advise me how to solve this error?
Full macros code is below.
Function getYield() As Double
Dim appIE As Object
Set appIE = CreateObject("internetexplorer.application")
With appIE
.Navigate "http://uk.investing.com/rates-bonds/world-government-bonds"
.Visible = False
End With
Do While appIE.Busy
DoEvents
Loop
Set allRowOfData = appIE.document.getElementById("pair_23705")
Dim myValue As Double: myValue = allRowOfData.Cells(2).innerHTML
appIE.Quit
Set appIE = Nothing
Worksheets("Reverse_PE").Range("B7").Value = myValue
Worksheets("Reverse_PE").Range("B7").Value = Worksheets("Reverse_PE").Range("B7").Value / 100
End Function
Sub adjust()
Dim copyAdress As Range
Dim copyRange As Range
Dim lastRow As Long
Dim Median As Range
'''PE'''
Set copyAdress = Worksheets("current").Range("A1:CJ10000").Find("PE_RATIO", lookat:=xlPart)
lastRow = Cells(65536, copyAdress.Column).End(xlUp).Row
Set copyRange = Worksheets("current").Range(Cells(copyAdress.Row + 1, copyAdress.Column), Cells(lastRow, copyAdress.Column))
Worksheets("PE").Range("B1").EntireColumn.Insert
copyRange.Copy Destination:=Sheets("PE").Range("B7", "B" & lastRow)
Worksheets("PE").Range("B2").Value = Worksheets("current").Range("A1").Value
Worksheets("PE").Range("B3").FormulaArray = "=MEDIAN(B7:B" & lastRow + 2 & ")"
Worksheets("PE").Range("B5").Font.Bold = True
Worksheets("PE").Range("B5").FormulaArray = "=IF(ISNUMBER(VLOOKUP($A$5,$A$7:$HI$1750,COLUMN(B4),FALSE)),VLOOKUP($A$5,$A$7:$HI$1750,COLUMN(B4),FALSE)," & Chr(34) & NA & Chr(34) & ")"
Set copyRange = Worksheets("current").Range("A5", "A" & lastRow)
copyRange.Copy Destination:=Sheets("PE").Range("A7", "A" & lastRow + 2)
''Dividend yield'''
Set copyRange = Worksheets("current").Range("A5", "A" & lastRow)
copyRange.Copy Destination:=Sheets("div. yield").Range("A7", "A" & lastRow + 2)
Worksheets("div. yield").Range("B7").FormulaArray = "=IF(ISNUMBER(current!X5),current!X5," & Chr(34) & Chr(34) & ")"
Worksheets("div. yield").Range("B7").Select
Selection.AutoFill Destination:=Sheets("div. yield").Range("B7:B" & lastRow + 2), Type:=xlFillDefault
'''PE Forward'''
Set copyAdress = Worksheets("current").Range("A1:CJ10000").Find("P/E-Ratio 03E", lookat:=xlPart)
lastRow = Cells(65536, copyAdress.Column).End(xlUp).Row
Set copyRange = Worksheets("current").Range(Cells(copyAdress.Row + 3, copyAdress.Column), Cells(lastRow, copyAdress.Column))
Worksheets("PE_forward").Range("B1").EntireColumn.Insert
copyRange.Copy Destination:=Sheets("PE_forward").Range("B7", "B" & lastRow + 2)
Worksheets("PE_forward").Range("B2").Value = Worksheets("current").Range("A1").Value
Worksheets("PE_forward").Range("B3").FormulaArray = "=MEDIAN(B7:B" & lastRow + 2 & ")"
Worksheets("PE_forward").Range("B5").Font.Bold = True
Worksheets("PE_forward").Range("B5").FormulaArray = "=IF(ISNUMBER(VLOOKUP($A$5,$A$7:$HI$1750,COLUMN(B751),FALSE)),VLOOKUP($A$5,$A$7:$HI$1750,COLUMN(B751),FALSE)," & Chr(34) & NA & Chr(34) & ")"
Worksheets("PE_forward").Columns("B").Replace What:="#VALUE!", Replacement:=""
Worksheets("PE_forward").Range("B3").NumberFormat = ""
Set copyRange = Worksheets("current").Range("A5", "A" & lastRow)
copyRange.Copy Destination:=Sheets("PE_forward").Range("A7", "A" & lastRow + 2)
'''Reverse PE'''
Set copyRange = Worksheets("current").Range("A5", "A" & lastRow)
copyRange.Copy Destination:=Sheets("Reverse_PE").Range("A9", "A" & lastRow + 4)
Worksheets("Reverse_PE").Range("B1").EntireColumn.Insert
Worksheets("Reverse_PE").Range("B2").Value = Worksheets("current").Range("A1").Value
Worksheets("Reverse_PE").Range("B5").FormulaArray = "=IF(ISNUMBER(VLOOKUP($A$5,$A$9:$HI$1750,COLUMN(B751),FALSE)),VLOOKUP($A$5,$A$9:$HI$1750,COLUMN(B751),FALSE)," & Chr(34) & NA & Chr(34) & ")"
getYield
Worksheets("Reverse_PE").Range("B3").FormulaArray = "=MEDIAN(B9:B" & lastRow + 4 & ")"
Worksheets("Reverse_PE").Range("B9").FormulaArray = "=IF(ISNUMBER(PE!B7),1/PE!B7," & Chr(34) & Chr(34) & ")"
Worksheets("Reverse_PE").Range("B9").Select
Selection.AutoFill Destination:=Sheets("Reverse_PE").Range("B9:B" & lastRow + 4), Type:=xlFillDefault
Worksheets("Reverse_PE").Range("B3:B" & lastRow + 4).Select
Selection.Style = "Percent"
Selection.NumberFormat = "0.00%"
You can't use the select method unless the sheet is first active, so add this line:
Worksheets("div. yield").Activate
Worksheets("div. yield").Range("B7").FormulaArray = "=IF(ISNUMBER(current!X5),current!X5," & Chr(34) & Chr(34) & ")"
and later at:
Worksheets("Reverse_PE").Activate
Worksheets("Reverse_PE").Range("B9").Select
There are much faster and more maintainable ways of doing what you're trying to do, but the above sheet activation will solve your immediate problem.
Don't forget to activate each sheet before you try to select one of the cells on it.