I'm working with exceland I try to run this command and I get the 424 Error.... The code is very simple and yet I can't find a solution.
Private Sub Run_Click()
Dim Weekly As Worksheet
Set Weekly = ThisWorkbook.Sheets("Weekly")
Todaydate = Range("D4").Value
foo = WorksheetFuncton.Match(Todaydate, Weekly.Range("A1489:A1499"), 0)
End Sub
EDIT:
I am now getting Runtime error 1004
Private Sub Run_Click()
Dim Weekly As Worksheet
Set Weekly = ThisWorkbook.Sheets("Weekly")
Todaydate = Range("D4").Value
foo = WorksheetFunction.Match(Todaydate, Weekly.Range("A1489:A1499"), 0)
End Sub
EDIT:
Fixed it!
I was mising a ".Value"
foo = WorksheetFunction.Match(Todaydate, Weekly.Range("A1489:A1499").Value, 0)
Check your spelling:
WorkSheetFunct i on
Related
I am trying to name a worksheet depending on the entered text of a cell with:
Sheet2.Name = Range("C2")
This is working in another macro:
Sub Sheetname()
Sheet3.Unprotect
ThisWorkbook.Unprotect
Sheet3.Name = Range("C2")
Sheet3.Protect ""
ThisWorkbook.Protect
End Sub
On my main macro it gives me
Run-Time error '1004'
Method 'Name' of object'_Worksheet' failed
Sub write_date_plant1()
ThisWorkbook.Unprotect
Sheets("Total").Unprotect
Sheets("MPT").Unprotect
Dim score As Integer
score = WorksheetFunction.WeekNum(Now())
'score = Range("B1").Value
If score = Worksheets("MPT").Range("B3") Then
Sheets("MPT").Range("B4").Value = Sheet2.Range("ok_plant1").Value
Sheets("MPT").Range("B5").Value = Sheet2.Range("minor_plant1").Value
Sheets("MPT").Range("B6").Value = Sheet2.Range("pdca_plant1").Value
Sheets("MPT").Range("B7").Value = Sheet2.Range("major_plant1").Value
Sheets("MPT").Range("B8").Value = Sheet2.Range("nope_plant1").Value
End If
...
If score = Worksheets("MPT").Range("Q3") Then
Sheets("MPT").Range("Q4").Value = Sheet2.Range("ok_plant1").Value
Sheets("MPT").Range("Q5").Value = Sheet2.Range("minor_plant1").Value
Sheets("MPT").Range("Q6").Value = Sheet2.Range("pdca_plant1").Value
Sheets("MPT").Range("Q7").Value = Sheet2.Range("major_plant1").Value
Sheets("MPT").Range("Q8").Value = Sheet2.Range("nope_plant1").Value
End If
Sheets("Total").Range("C4") = Date
Sheet2.Name = Range("C2")
Sheets("Total").Protect
Sheets("MPT").Protect
ThisWorkbook.Protect
End Sub
By far the most common cause of a run-time Error 1004 is when VBA code refers to a named range that doesn’t exist. Perhaps the name is spelled wrong in the code. Or maybe an invalid name is used.
Check if all your ranges exist:
Sheets("Total")
Sheets("MPT")
Sheet2.Name = Range("C2")
Sheet2.Range("ok_plant1")
Sheet2.Range("minor_plant1")
Sheet2.Range("pdca_plant1")
Sheet2.Range("pdca_plant1")
Sheet2.Range("nope_plant1")
Check all the above ranges if they exist.
When the code is applied to a pivot table that has no PageRange property the code fails with the error in the title
I tried to apply a boolean variable to
sh.PivotTables(i).PageRange
but that did not work either
Sub TestPivotPaste2()
Dim wb As Workbook
Dim sh As Worksheet
Set wb = ActiveWorkbook
Set sh = wb.Worksheets(7)
c = sh.PivotTables.Count
If c > 0 Then
For i = 1 To c
If Not sh.PivotTables(i).PageRange.Count = 0 Then
Debug.Print c
Else
GoTo nextpiv
End If
nextpiv:
Next i
Else
MsgBox ("NoPivot")
End If
End Sub
the expected result is to be able to discern the pivot tables where the PageRange property is true or false, but it only works when the range exists.
Try this function
Function pageRangeExists(pt as PivotTable) as Boolean
Dim test as Range
On Error Resume Next
Set test = pt.PageRange
On Error Go To 0
pageRangeExists = Not test Is Nothing
End Function
Since PageRange is a range object, you have to test if the range exists or is valid first, as trying to act against a range that is not there will produce an error.
And with that your for loop can be simplified
For i = 1 To c
If pageRangeExists(sh.PivotTables(i)) Then
Debug.Print c
End If
Next i
The GoTo statement is superfluous as it is logic already embedded in a for loop.
I'm trying to determine if a named range has been set via VBA. The named range is called LoadedToken and essentially is loaded when a user clicks a particular button. I use this as proof that initialisation has taken place.
I have a function to check if this has taken place:
Function ToolIsEnabled()
' We check if the R2A add-in has been loaded by detecting the named range
If ActiveWorkbook.Names("LoadedToken") Is Nothing Then
ToolIsEnabled = False
Else
ToolIsEnabled = True
End If
End Function
and I get an application error. Of course, the VBA is incorrect. However how can I actually accomplish this?!
Sub Test()
Debug.Print IsNamedRange("Bumsti")
End Sub
Function IsNamedRange(RName As String) As Boolean
Dim N As Name
IsNamedRange = False
For Each N In ActiveWorkbook.Names
If N.Name = RName Then
IsNamedRange = True
Exit For
End If
Next
End Function
Usage in OP context could be
' ...
If IsNamedRange("LoadedToken") Then
' ...
End If
' ...
or - if a program specific Bool needs to be set
' ...
Dim IsTokenLoaded as Boolean
IsTokenLoaded = IsNamedRange("LoadedToken")
' ...
Both constructs make it pretty clear in the source code what you are aiming for.
You can achieve this by using error handling:
Function ToolIsEnabled() As Boolean
Dim rng As Range
On Error Resume Next
Set rng = ActiveWorkbook.Range("LoadedToken")
On Error GoTo 0
ToolIsEnabled = Not rng is Nothing
End Function
This will check either in ThisWorkbook or a named workbook and return TRUE/FALSE.
Sub Test()
MsgBox NamedRangeExists("SomeName")
MsgBox NamedRangeExists("SomeOtherName", Workbooks("Book1.xls"))
End Sub
Public Function NamedRangeExists(sName As String, Optional Book As Workbook) As Boolean
On Error Resume Next
If Book Is Nothing Then
Set Book = ThisWorkbook
End If
NamedRangeExists = Book.Names(sName).Index <> (Err.Number = 0)
On Error GoTo 0
End Function
Edit:
A shorter version if it's only going to look in ThisWorkbook:
Public Function NamedRangeExists(sName As String) As Boolean
On Error Resume Next
NamedRangeExists = ThisWorkbook.Names(sName).Index <> (Err.Number = 0)
On Error GoTo 0
End Function
For the activeworkbook, you could also call the old XLM NAMES() function:
Function IsNameInActiveWorkbook(sName As String) As Boolean
IsNameInActiveWorkbook = Not IsError(Application.ExecuteExcel4Macro("MATCH(""" & sName & """,NAMES(),0)"))
End Function
As per Tom's answer these 2 line should do the trick:
On Error Resume Next
Set TestRange = ActiveWorkbook.Range("LoadedToken") 'if it does **not** exist this line will be ERROR
I created code that will copy the RecordSet to Excel and I want a macro in the Excel file to run. The code works perfectly until it hits the code to run the macro. I must not be calling the application correctly but can't figure it out!
Private Sub Command233_Click()
Dim objXLS As Object
Dim wks As Object
Dim rsc As Recordset
Dim idx As Long
Set rsc = Me.RecordsetClone
If Me.RecordsetClone.RecordCount = 0 Then
MsgBox ("No Records To Export")
Else
rsc.MoveLast
rsc.MoveFirst
Set objXLS = CreateObject("Excel.Application")
objXLS.Workbooks.Open FileName:="C:\Comps Macro.xlsm", ReadOnly:=True
Set wks = objXLS.Worksheets(1)
For idx = 0 To rsc.Fields.Count - 1
wks.Cells(1, idx + 1).Value = rsc.Fields(idx).Name
Next
wks.Range(wks.Cells(1, 1), wks.Cells(1, rsc.Fields.Count)).Font.Bold = True
wks.Range("A2").CopyFromRecordset rsc, rsc.RecordCount, rsc.Fields.Count
objXLS.Visible = True
objXLS.Run ("Format")
End If
Set objXLS = Nothing
End Sub
The runtime error I am receiving is:
Run-Time Error '-2147417851 (80010105)':
Method 'Run' of object '_Application' failed
You have to reference the Sub or Function correctly.
Your Sub named Format is defined at Workbook- or Sheet- level?
If defined in a Sheet module (for example Sheet1):
objXLS.Run ("Sheet1.Format")
If at Workbook level:
objXLS.Run ("ThisWorkbook.Format")
Hope this helps
I have done a "copy and paste" to a value after comparing the "road" number and the code number. If those two are matching, Excel VBA will copy and paste in a cell defined. I have created a loop to repeat it. But I discovered that up to 7000 my program was working properly, and when I replaced 7000 by 30000, Excel VBA displays
"Run-time error '13' Type mismatch "
after a certain time. I dont know why. Below is my program:
Private Sub assigment()
Dim road As Double
Dim code As Double
Dim i As Double
For i = 4 To 30000
For code = 2 To 22
For road = 4 To 65
If ActiveWorkbook.Sheets("assignment").Cells(i, 6)=ActiveWorkbook.Sheets("SSUSE").Cells(3, code) Then
If ActiveWorkbook.Sheets("assignment").Cells(i, 8) = ActiveWorkbook.Sheets("SSUSE").Cells(road, 1) Then
ActiveWorkbook.Sheets("SSUSE").Cells(road, code).Copy ActiveSheet.Paste Destination:=ActiveWorkbook.Sheets("assignment").Cells(i, 10)
End If
End If
Next
Next
Next
End Sub
Dim vSource as Variant, vCode as Variant, vRoad as Variant, vAssignment as Variant, vAddress as Variant
vSource = ActiveWorkbook.Sheets("assignment").Range("F4:F30000").Value
vCode = ActiveWorkbook.Sheets("SSUSE").Range("B3:V3").Value
vRoad = ActiveWorkbook.Sheets("SSUSE").Range("A4:A65").Value
vAddress = ActiveWorkbook.Sheets("SSUSE").Range("B4:V65").Value
vAssignment = ActiveWorkbook.Sheets("assignment").Range("H4:H30000").Value
For i = LBound(vSource,1) to UBound(vSource,1)
For code = LBound(vCode,2) to UBound(vCode,2)
For road = LBound(vRoad,1) to UBound(vRoad,1)
If (vSource(i,1) = vCode(1, code)) AND (vAssignment(i,1) = vRoad(road,1)) Then
ActiveWorkbook.Sheets("assignment").Cells(i+3, 10).Value = vAddress(Road,Code)
End If
Next
Next
Next