I am trying to duplicate color from a different workbook but getting a run-time error 438: Object doesn't support this property or method on the last line. I believe that before setting the workbooks and worksheet to certain names, it worked. What am I doing wrong?
Sub TextColor()
Dim wb1 As Workbook
Dim wb2 As Workbook
Dim ws1 As Worksheet
Application.ScreenUpdating = False
Set wb1 = Workbooks("File 1.xlsm")
Set wb2 = Workbooks("File 2.xlsm")
Set ws1 = Worksheets("Sheet 1")
wb2.Worksheets("Destination Sheet").Range("G4").Interior.Color = wb1.ws1.Range("D19").Interior.Color
The object 'ws1' is created separately and, while a child object of 'wb1', the variable itself is not a child object of it, only the reference to it. Valid referencing styles would be:
ws1
wb1.Worksheets("Sheet1")
Also, when you set 'ws1' you should reference the parent workbook in that line. This would change your 'ws1' line to now be:
Set ws1 = wb1.Worksheets("Sheet1")
From then on you only need to reference 'ws1' as the object.
As a side note, when working with other workbooks, I recommend testing if the worksheet exists or not. If you hard-code the name in and it doesn't exist, gets changed, or you made a typing error, this can throw an error. Below is a function you can use to test if a worksheet exists or not.
Function WorksheetExists( _
ByVal SheetName As String, _
Optional TargetBook As Workbook _
) As Boolean
If TargetBook Is Nothing Then
If ActiveWorkbook Is Nothing Then Exit Function
Set TargetBook = ActiveWorkbook
End If
On Error Resume Next
WorksheetExists = CBool(Len(TargetBook.Worksheets(SheetName).Name) <> 0)
On Error GoTo 0
End Function
The same logic applies if you're looking for a workbook and need to know if it exists, although a function for it would be slightly different, shown in the below code.
Public Function ExistingFile( _
ByVal FilePath As String _
) As Boolean
Dim Attributes As Integer
On Error Resume Next
Attributes = GetAttr(FilePath)
ExistingFile = (Err.Number = 0) And (Attributes And vbDirectory) = 0
Err.Clear
End Function
Note the above function could potentially throw an error if the file name is too long.
Related
I am trying to create a subroutine that will take a collection of a bunch of strings, step through it, and check for the existence of a named range or formula that has that string as it's name. Trying it with just one item first:
Dim colCritNames As New Collection
colCritNames.Add "Version" 'the name of a named formula
For i = 1 To colCritNames.Count
nm = CStr(colCritNames(i).Name)
nmchk = Check_UW_For_Name(nm)
If Not nmchk Then Call Fail("Critical Name") 'prints a msgbox with the error type so I know what happened
Next i
'...code for if all the names are there...
Function Check_UW_For_Name(find_name As String) As Boolean
Dim wb As Workbook
Set wb = UserFileBook 'global ref to the workbook to check
On Error Goto Fail
Check_UW_For_Name = CBool(Len(wb.Names(find_name).Name) <> 0)
On Error GoTo 0
End Function
Thats edited from the full thing. Check_UW_For_Name was working fine when I just called it with "Version" as the argument Check_UW_For_Name("Version"); it found it in USerFIleBook, and when I called it with "Nope", since there is no Nope name it went to my error handler. But when I try to use a collection to store the names I want to look for I keep getting 'ByRef argument mismatch'. I tried just nm = colCritNames(i) and nm=colCritNames(i).Name, I tried having find_name be Variant and adding a ByVal, and I originally tried having nm be a Name, having Check_UW_For_Name(find_name as Name) and using a for each (for each nm in colCritNames...) and none of it has worked.
How could I set a collection of names and step through it to see if there's a named range/formula that matches in the relevant workbook? Or is there a better way to do this? (I need the collection in other places too)
I don't quite understand what your plan is with a collection, but this will add any cell with the specified string in, as well as any ranges. What you're doing once they've been identified (added to collection) is not clear to me, but hopefully this makes sense and gets you going.
Sub RunForEachString()
Const yourStrings = "foo,bar,hope,this,works"
Dim stringsAsArray() As String
stringsAsArray = Split(yourStrings, ",")
Dim i As Long
For i = LBound(stringsAsArray) To UBound(stringsAsArray)
Call findAllNamesFormulas(stringsAsArray(i), ThisWorkbook)
Next i
End Sub
Private Sub findAllNamesFormulas(theText As String, theWorkbook As Workbook)
Dim ws As Worksheet, n As Name, aCell As Range
Dim aCollection As New Collection
For Each ws In ThisWorkbook.Worksheets
For Each aCell In ws.UsedRange.Cells
If InStr(1, aCell.Formula, theText, vbTextCompare) > 0 Then
aCollection.Add (aCell)
End If
Next aCell
Next ws
For Each n In ThisWorkbook.Names
If InStr(1, n.Name, theText, vbTextCompare) > 0 Then
aCollection.Add (n)
End If
Next n
'not sure what you plan to do after collection?
Debug.Print aCollection.Count
End Sub
This works for me:
Sub Tester()
Dim colCritNames As New Collection, nm, wb As Workbook, msg As String
colCritNames.Add "Version"
colCritNames.Add "NotThere"
colCritNames.Add "AlsoNotThere"
Set wb = ThisWorkbook 'for example
For Each nm In colCritNames
If Not Check_UW_For_Name(wb, CStr(nm)) Then
msg = msg & vbLf & " - " & nm
End If
Next nm
If Len(msg) > 0 Then
MsgBox "One or more required names are missing:" & msg, _
vbExclamation, "Oops"
Exit Sub
End If
'proceed if OK...
End Sub
'check for a defined Name `find_name` in workbook `wb`
' prefer wb as parameter over using a Global....
Function Check_UW_For_Name(wb As Workbook, find_name As String) As Boolean
On Error Resume Next
Check_UW_For_Name = (wb.Names(find_name).Name = find_name)
End Function
You could create a collection of all named ranges in the workbook like this:
Private Sub NamedRangesDemo()
Dim NamedRanges As New Collection, NamedRange As Variant
For Each NamedRange In ThisWorkbook.Names
NamedRanges.Add NamedRange.Name
Next NamedRange
End Sub
And then compare the whatever strings you want to the NamedRanges collection.
By the way, this question is somewhat similar to yours.
I have a macro that is to be used inside a macro I found on internet.
The second macro runs through all Excel files inside a folder:
Sub RunOnAllFilesInFolder()
Dim folderName As String, eApp As Excel.Application, fileName As String
Dim wb As Workbook, ws As Worksheet, currWs As Worksheet, currWb As Workbook
Dim fDialog As Object: Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
Set currWb = ActiveWorkbook: Set currWs = ActiveSheet
'Select folder in which all files are stored
fDialog.Title = "Select a folder"
fDialog.InitialFileName = currWb.Path
If fDialog.Show = -1 Then
folderName = fDialog.SelectedItems(1)
End If
'Create a separate Excel process that is invisibile
Set eApp = New Excel.Application: eApp.Visible = False
'Search for all files in folder [replace *.* with your pattern e.g. *.xlsx]
fileName = Dir(folderName & "\*.*")
Do While fileName <> ""
'Update status bar to indicate progress
Application.StatusBar = "Processing " & folderName & "\" & fileName
Set wb = eApp.Workbooks.Open(folderName & "\" & fileName)
'...
'YOUR CODE HERE
'...
wb.Close SaveChanges:=False 'Close opened worbook w/o saving, change as needed
Debug.Print "Processed " & folderName & "\" & fileName
fileName = Dir()
Loop
eApp.Quit
Set eApp = Nothing
'Clear statusbar and notify of macro completion
Application.StatusBar = ""
MsgBox "Completed executing macro on all workbooks"
End Sub
I made a macro that, based on three named cells in a file, finds the ranges and change the style of some other ranges.
Not all Excel files have all three named cells, so I need the code to work when the range is not valid.
I tried to use error handlers but I received the following error:
"Loop without Do"
I tried IF and else for when the range does not exist and also found errors.
My code:
Dim test As Worksheet
Dim rOutstandingR As Range
Dim rAdditionalDueR As Range
Dim rFollowingR As Range
Dim rOutstandingBorderR As Range
Dim rAdditionalDueBorderR As Range
Dim rFollowingBorderR As Range
Dim ORow As Long
Dim OCol As Long
Dim ARow As Long
Dim ACol As Long
Dim FRow As Long
Dim FCol As Long
Dim OutstandingTopBorderRange As Range
Dim OutstandingBottomBorderRange As Range
Dim OutstandingRightBorderRange As Range
Dim AdditionalDueTopBorderRange As Range
Dim AdditionalDueBottomRange As Range
Dim AdditinalDueRightBorderRange As Range
Dim FollowingTopBorderRange As Range
Dim FollowingBottomBorderRange As Range
Dim FollowingRightBorderRange As Range
Dim OutstandingTextRange As Range
Dim AdditionalDueTextRange As Range
Dim FollowingTextRange
With Range("A1:Z999")
'Setting up another range that may not exists within excel file and give an error
Set rOutstandingR = ActiveSheet.Range("Outstanding")
rOutstandingBorderR = rOutstandingR.Address
rOutstandingR.Select
‘more code in which I change format of cells based on range
'Setting up another range that may not exists within excel file and give an error
Set rAdditionalDueR = ActiveSheet.Range("AdditionalDue")
rAdditionalDueBorderR = rAdditionalDueR.Address
rAdditionalDueR.Select
‘more code in which I change format of cells based on range
'Setting up another range that may not exists within excel file and give an error
'Setting Up rFollowingR as Range for Following Variable
Set rFollowingR = ActiveSheet.Range("Following")
rFollowingBorderR = rFollowingR.Address
rFollowingR.Select
‘more code in which I change format of cells based on range
As you can imagine by the amount of ranges, there is a lot of code in between but it's only based on the three major ranges for the named cells "Outstanding", "AdditionalDue" and "Following".
I need that all the codes between ranges work and if the first range doesn't exist goes to validate then next and do the changes of format, etcetera.
I tried to put some error handlers (resume labels) but I wasn't able to fix it when I used the code above within the first macro due to the loop through all the files.
How can I put the error handlers so I could use this macro inside the one that runs over a folder of files.
There are two ways to handle this, however with the snippets provided it's not straightforward to test what you're working on. You may want to consider separating your code into multiple subs/functions.
This solution should be clean assuming that you want some type of handling code to run:
With range("A1:Z999")
'Setting up another range that may not exists within excel file and give an error
On Error GoTo OutstandingError
Set rOutstandingR = ActiveSheet.range("Outstanding")
rOutstandingBorderR = rOutstandingR.Address
rOutstandingR.Select
OutstandingResume:
'more code in which I change format of cells based on range
'Setting up another range that may not exists within excel file and give an error
On Error GoTo AdditionalDueError
Set rAdditionalDueR = ActiveSheet.range("AdditionalDue")
rAdditionalDueBorderR = rAdditionalDueR.Address
rAdditionalDueR.Select
AdditionalDueResume:
'more code in which I change format of cells based on range
'Setting up another range that may not exists within excel file and give an error
'Setting Up rFollowingR as Range for Following Variable
On Error GoTo FollowingError
Set rFollowingR = ActiveSheet.range("Following")
rFollowingBorderR = rFollowingR.Address
rFollowingR.Select
FollowingResume:
'more code in which I change format of cells based on range
GoTo Complete
OutstandingError:
'Error handling code here
Resume OutstandingResume
AdditionalDueError:
'Error handling code here
Resume AdditionalDueResume
FollowingError:
'Error handling code here
Resume FollowingResume
Complete:
This solution just bypasses the block entirely without any handling code:
With range("A1:Z999")
'Setting up another range that may not exists within excel file and give an error
On Error GoTo OutstandingResume
Set rOutstandingR = ActiveSheet.range("Outstanding")
rOutstandingBorderR = rOutstandingR.Address
rOutstandingR.Select
OutstandingResume:
'more code in which I change format of cells based on range
'Setting up another range that may not exists within excel file and give an error
On Error GoTo AdditionalDueResume
Set rAdditionalDueR = ActiveSheet.range("AdditionalDue")
rAdditionalDueBorderR = rAdditionalDueR.Address
rAdditionalDueR.Select
AdditionalDueResume:
'more code in which I change format of cells based on range
'Setting up another range that may not exists within excel file and give an error
'Setting Up rFollowingR as Range for Following Variable
On Error GoTo FollowingResume
Set rFollowingR = ActiveSheet.range("Following")
rFollowingBorderR = rFollowingR.Address
rFollowingR.Select
FollowingResume:
'more code in which I change format of cells based on range
If you'd like to go in a different direction, here is a function that returns a boolean for whether or not a named range exists. Using this you could refactor this to use conditionals instead of relying on error checking and line jumps.
Private Function BET_RangeNameExists(nname) As Boolean
Dim n As Name
BET_RangeNameExists = False
For Each n In ActiveWorkbook.Names
If UCase(n.Name) = UCase(nname) Then
BET_RangeNameExists = True
Exit Function
End If
Next n
End Function
Taken from https://bettersolutions.com/excel/named-ranges/vba-named-range-exists.htm
Here is an example setting:
Dim wb As Workbook
Dim ws As Worksheet
Dim rn As Range
More specifically in my scenario:
The call:
Select Case CheckInDb(Range("Username"), "\..\_DataBase_\", "UserBase.xlsm", Sheets("UD_Base"), Range("UD_Base[U_ID]"))
The function header:
Function CheckInDb(What As Variant, Folder As String, FileName As String, Ws As Worksheet, Rn As Range)
I wanted to do something like this within the function (after opening the file, etc.):
(note: Wb is generated within the function)
CheckInDb = IsError(Application.Match(What,Wb.Ws.Rn, 0))
I have tried in several ways to precombine them step by step instead, but did not succeed with any
for example
set ws = wb.Sheets("RangeAdding")
would work manually, but Ws=Wb.Ws NOT. How to work around this, to achieve all 3 parts coming from variables?
Adding more information
I will post my full function to show what the real issue is. I have modded it a bit according to your suggestions, and the problem is:
The Workbook only gets opened inside the function, however if it is not open already when I write the full range in the calling it will give me an error, that it does not exist. Therefore I wanted to first ever use the range "live" inside the function, when the reference is already open.
Sub checkUser()
Select Case CheckInDb(Range("Username"), "\..\_DataBase_\", "UserBase.xlsm", Workbooks("Userbase.xlsm").Sheets("UD_Base").Range("UD_Base[U_ID]"))
Case True: Range("Status_U").Value = ("Szabad")
Case False: Range("Status_U").Value = ("Foglalt")
End Select
End Sub
Function CheckInDb(What As Variant, Folder As String, FileName As String, Rng As Range)
Dim Wb As Workbook
Dim wasOpen As Boolean
Dim File As String, Path As String
' Relative path:
Path = ThisWorkbook.Path & Folder
File = Path & FileName
On Error Resume Next
Set Wb = Workbooks(FileName)
wasOpen = True
On Error GoTo 0
If Wb Is Nothing Then
Set Wb = Workbooks.Open(File, , True) 'with settings: (File, true,true, , PW)
wasOpen = False
End If
'...
CheckInDb = IsError(Application.Match(What, Rng, 0))
'...
Select Case wasOpen
Case True
'Wb.Save
Case False
'Wb.Save
Wb.Close (False)
End Select
Set Wb = Nothing
End Function
Your rn object already knows which Worksheet object it belongs to. (You can use rn.Parent to refer to that worksheet.) And the worksheet knows which Workbook object it belongs to. (You can use rn.Parent.Parent to refer to that workbook.)
So your code should be:
CheckInDb = IsError(Application.Match(What, Rn, 0))
This means there is no need to pass the workbook and worksheet information to your function (because it is inherent in the Range you are passing), i.e.:
Select Case CheckInDb(Range("Username"), Range("UD_Base[U_ID]"))
and
Function CheckInDb(What As Variant, Rn As Range)
Based on your edit to the question, which now makes it clear that all the objects in the calling procedure don't exist when you execute the call (and therefore the call fails), you should pass the names of your workbook (as you already do), worksheet and range, i.e.:
Sub checkUser()
Select Case CheckInDb(Range("Username"), _
"\..\_DataBase_\", "UserBase.xlsm", _
"UD_Base", _
"U_ID")
Case True: Range("Status_U").Value = ("Szabad")
Case False: Range("Status_U").Value = ("Foglalt")
End Select
End Sub
Function CheckInDb(What As Variant, _
Folder As String, FileName As String, _
wsName As String,
rngName As String) As Boolean
'...
'... existing code to create wb object
'...
Dim rn As Range
Set rn = wb.Worksheets(wsName).Range(rngName)
CheckInDb = IsError(Application.Match(What, Rn, 0))
I'm trying to extract data from other 4 workbooks (some of them may have thousands of rows)
The Excel stops working, and restarts, after the extraction is completed.
I have the data extracted in the sheets so I assume that the excel is chrashing after the last workbook data is extracted.
I also tested with only one workbook and it crashes after closing.
I have read that we could use "DoEvents" and "Application.Wait" after copy/paste or close workbook, to let Excel finish some background work. I've tried that but with no success.
Any ideas why the Excel stops running / restarts?
Here is my code:
Public sysExtractParamsDictionary As Scripting.dictionary
'Sub rotine triggered when pressing button
Sub Extract()
Set sysExtractParamsDictionary = mUtils.FillDictionary("sysParams", "tExtractParams") 'Sub rotine belonging to mUtils module to fill dictionary with values from my sysParams sheet. Contains the sheets name.
mClean.Clean 'Sub rotine belonging to mClean module to clear sheets
ExtractData [sysInputDirectory], "Input Sheet" 'Cell Name sysInputDirectory
ExtractData [sysR2Directory], "R1 Sheet"
ExtractData [sysR2Directory], "R2 Sheet"
ExtractData [sysR3Directory], "R3 Sheet"
End Sub
Sub ExtractData(sFilePath As String, sDictionaryKey As String)
Dim oWorkbook As cWorkBook 'Class Module
Set oWorkbook = New cWorkBook
mUtils.SetStatusBarMessage True, "Extracting " & sDictionaryKey & " ..." 'Sub rotine belonging to my mUtils module to set on or off status bar message
oWorkbook.WorkBookDirectory = sFilePath
oWorkbook.OpenWorkBook oWorkbook.WorkBookDirectory
oWorkbook.CopiesSourceSheetValuesToDestinationSheet sysExtractParamsDictionary(sDictionaryKey)
oWorkbook.CloseWorkBook (False)
DoEvents
DoEvents
Application.Wait (Now + TimeValue("0:00:05"))
DoEvents
Set oWorkbook = Nothing
End Sub
'#### Class Module
Private wbWorkBook As Workbook
Private sWorkBookDirectory As String
Private sWorkBookName As String
Private wsWorksheet As Worksheet
Public Property Set Workbook(wbNew As Workbook)
Set wbWorkBook = wbNew
End Property
Public Property Get Workbook() As Workbook
Set Workbook = wbWorkBook
End Property
Public Property Let WorkBookDirectory(sFilePath As String)
sWorkBookDirectory = sFilePath
End Property
Public Property Get WorkBookDirectory() As String
WorkBookDirectory = sWorkBookDirectory
End Property
Public Property Let WorkBookName(sFileName As String)
sWorkBookName = sFileName
End Property
Public Property Get WorkBookName() As String
WorkBookName = sWorkBookName
End Property
Public Property Set Worksheet(wsNew As Worksheet)
Set wsWorksheet = wsNew
End Property
Public Property Get Worksheet() As Worksheet
Worksheet = wsWorksheet
End Property
Public Property Let WorkBookDirectory(sFilePath As String)
sWorkBookDirectory = sFilePath
End Property
Public Property Get WorkBookDirectory() As String
WorkBookDirectory = sWorkBookDirectory
End Property
'Class Module Function to Open WorkBook
Public Sub OpenWorkBook(sFilePath As String)
Dim oFSO As New FileSystemObject
Dim sFileName As String
Dim sLog As String
sFileName = oFSO.GetFileName(sFilePath) 'Get the File Name from Path
If sFileName = "" Then
sLog = "Error. Not possible to retrieve File Name from Directory."
Else
Me.WorkBookName = sFileName
Set Me.Workbook = Workbooks.Open(sFilePath)
If wbWorkBook Is Nothing Then
sLog = "Error opening file: " & Me.WorkBookName
Else
sLog = "File successfully openned!"
End If
End If
Set oFSO = Nothing
End Sub
'Class Module Function to Copy Values from source to destination
Public Sub CopiesSourceSheetValuesToDestinationSheet(wsDestinationName As Variant)
Dim wsDestination As Worksheet
Dim rStartRange As range
Dim rFullRangeToPaste As range
Set wsDestination = ThisWorkbook.Sheets(CStr(wsDestinationName)) ' Destination Sheet
Set Me.Worksheet = Me.Workbook.Sheets(1) 'Source Sheet
Set rStartRange = wsWorksheet.range("A1")
Set rFullRangeToPaste = wsWorksheet.range(rStartRange, mUtils.FindLast(3)) 'FindLast is a function belonging to mUtils module to find the last cell in worksheet
rFullRangeToPaste.Copy wsDestination.Cells(wsDestination.Rows.Count, "A").End(xlUp)
End Sub
'Class Module Function to Close Workbook
Public Sub CloseWorkBook(bSaveChanges As Boolean)
wbWorkBook.Saved = True
wbWorkBook.Close SaveChanges:=False
End Sub
'#### End Class Module
I've also tried to do it without Class Module (just in case something was wrong with objects), but i still have the same issue.
Sub Extract()
ExtractCopyClose "C:\MyFiles\InputData.csv", "Input"
End Sub
Sub ExtractCopyClose(sFilePath As String, wsDestinationName As String)
Dim wb As New Workbook
Dim wsDestination As Worksheet
Dim wsSource As Worksheet
Dim oFSO As New FileSystemObject
Dim sLog As String
Dim rStartRange As range
Dim rFullRangeToPaste As range
sFileName = oFSO.GetFileName(sFilePath) 'Get the File Name from Path
If sFileName = "" Then
sLog = "Error. Not possible to retrieve File Name from Directory."
Else
Set wb = Workbooks.Open(sFilePath)
If wb Is Nothing Then
sLog = "Error opening file: " & sWorkBookName
Else
sLog = "File successfully openned!"
End If
End If
Set oFSO = Nothing
Set wsDestination = ThisWorkbook.Sheets(wsDestinationName) ' Destination Sheet
Set wsSource = wb.Sheets(1) 'Source Sheet
Set rStartRange = wsSource.range("A1")
Set rFullRangeToPaste = wsSource.range(rStartRange, mUtils.FindLast(3))
rFullRangeToPaste.Copy wsDestination.Cells(wsDestination.Rows.Count, "A").End(xlUp)
wb.Saved = True
wb.Close SaveChanges:=False
End Sub
I have found that the sheet I was importing from the other workbook had external connections and was creating Connections and new References in my Workbook. Don't know why, but somehow this was affecting my Excel and causing it to restart since I was copying all the sheet content.
Instead of copying the full source sheet to my workbook...
rFullRangeToPaste.Copy wsDestination.Cells(wsDestination.Rows.Count, "A").End(xlUp)
I copied only the values and formats of the source sheet...
Dim rDestinationRange As Range
'the rest of the code in question
rFullRangeToPaste.Copy wsDestination.Cells(wsDestination.Rows.Count, "A").End(xlUp)
Set rDestinationRange = wsDestination.Cells(wsDestination.Rows.Count, "A").End(xlUp)
rFullRangeToPaste.Copy
wsDestination.PasteSpecial xlPasteValuesAndNumberFormats
Note: This worked after my workbook recovered from the previous extraction (without broken external connections and null references). Then I made the changes in the code and save it.
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