runtime error 438 after opening workbook with vba

AndrewI

New Member
Joined
Nov 1, 2017
Messages
40
Hi Everyone, First ever post so apologies if i'm doing this wrong.
I have written some code that in theory is supposed to after being passed a filename selected from a list box(Listbox1) and a directory as a string (MyFolder), use these to see if that workbook is open. If it is then it copies and pastes data from that workbook into the one that houses this code.

If the workbook is not open, then the code should open it and then perform the same process as above (copying and pasting from just opened workbook to the one that is home to this code).
However it fails immediately after opening the workbook at the point where the code reads:
"Set ActiveWorkbook = Workbooks.Open(FileToOpen)"

I'm then greeted with the run time error 438 "Object Doesn't Support This Property or Method".
the code then ends and i'm given no debug option. The workbook I tried to open is opened though.
Here's the code with the point it breaks directly after the 200 marker

I have no idea why this is happening. Scoured loads of threads and can't work it out.

Apologies, I'm not the most elegant coder

Code:
Sub ImportTotals(MyFolder, Listbox1)


Dim wbk As Workbook
Dim NumberOfProducts As Integer
Dim FileToOpen As String
FileToOpen = MyFolder & "\" & Listbox1


Application.ScreenUpdating = False




For Each wbk In Workbooks


If wbk.FullName = FileToOpen Then


Workbooks(wbk.Name).Activate
GoTo 100


End If
Next
GoTo 200




100
ActiveWorkbook.Sheets("Overview").Select
Range("J70").Select
ActiveCell.Formula = "=COUNTIFS(J63:J68,""<>*PRODUCT*"",J63:J68,""<>"")"
NumberOfProducts = ActiveCell.Value
ActiveCell.clear
ThisWorkbook.Activate
Range("F10").Select
ActiveCell.Value = NumberOfProducts
Workbooks(wbk.Name).Activate
ActiveWorkbook.Sheets("Product Totals").Select


Range("A14:O" & (13 + (NumberOfProducts - 1)) + (NumberOfProducts * 33)).Select
Selection.Copy
ThisWorkbook.Activate
Range("B12").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Range("B12").Select
Application.CutCopyMode = False
Range("B" & (NumberOfProducts * 33) + (11 + (NumberOfProducts - 1))).Select
Dim LastRow As Integer
LastRow = ActiveCell.Row
Range("P12").Select
For x = 1 To LastRow
If ActiveCell.Value <> "0" Then


ActiveCell.Offset(1, 0).Select
Else: Rows(ActiveCell.Row).EntireRow.Delete
End If
Next




Exit Sub




200


Set ActiveWorkbook = Workbooks.Open(FileToOpen)


Sheets("overview").Select
Range("J70").Select
ActiveCell.Formula = "=COUNTIFS(J63:J68,""<>*PRODUCT*"",J63:J68,""<>"")"
NumberOfProducts = ActiveCell.Value
ActiveCell.clear
ThisWorkbook.Activate
Range("F10").Select
ActiveCell.Value = NumberOfProducts
Workbooks(wbk.Name).Activate
ActiveWorkbook.Sheets("Product Totals").Select


Range("A14:O" & (13 + (NumberOfProducts - 1)) + (NumberOfProducts * 33)).Select
Selection.Copy
ThisWorkbook.Activate
Range("B12").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Range("B12").Select
Application.CutCopyMode = False
Range("B" & (NumberOfProducts * 33) + (11 + (NumberOfProducts - 1))).Select


LastRow = ActiveCell.Row
Range("P12").Select
For x = 1 To LastRow
If ActiveCell.Value <> "0" Then


ActiveCell.Offset(1, 0).Select
Else: Rows(ActiveCell.Row).EntireRow.Delete
End If
Next


End Sub
 

Excel Facts

Square and cube roots
The =SQRT(25) is a square root. For a cube root, use =125^(1/3). For a fourth root, use =625^(1/4).
Welcome to the forum. :)

ActiveWorkbook is a property of the Application object and you really shouldn't try and use it as a variable. Opening a workbook should make it the active one anyway, so you could just remove that line.
 
Upvote 0
Welcome to the forum. :)

ActiveWorkbook is a property of the Application object and you really shouldn't try and use it as a variable. Opening a workbook should make it the active one anyway, so you could just remove that line.

Thanks for your reply.. are you referring to the line "Set ActiveWorkbook = Workbooks.Open(FileToOpen)"?

I don't really understand the concepts surrounding objects.. self taught relative newbie relying mostly on forums such as this to piece together bits to get what i want done.

Lol.. i actually thought that was progress. Before that I had
Workbooks.Open(FileToOpen) (tried both with and without parenthesis) and i was getting runtime error 91 Object variable or With block variable not set. It would break at the same point and again, no option to debug, it would just exit the code but the file had opened.

Thanks again.
 
Upvote 0
There's no need to repeat code, try this.
Code:
Sub ImportTotals(MyFolder, Listbox1)
Dim wbk As Workbook
Dim NumberOfProducts As Long
Dim FileToOpen As String
Dim LastRow As Long

    Application.ScreenUpdating = False

    FileToOpen = MyFolder & "\" & Listbox1

    For Each wbk In Workbooks
        If wbk.FullName = FileToOpen Then
            Exit For
        End If
    Next
    
    ' if workbook isn't open already open it
    If wbk Is Nothing Then
        Set wbk = Workbooks.Open(FileToOpen)
    End If

    With wbk
        .Sheets("Overview").Range("J70").Formula = "=COUNTIFS(J63:J68,""<>*PRODUCT*"",J63:J68,""<>"")"
        NumberOfProducts = .Sheets("Overview").Range("J70").Value
        .Sheets("Overview").Range("J70").Clear
    End With
    
    ThisWorkbook.ActiveSheet.Range("F10").Value = NumberOfProducts
    
    wbk.Sheets("Product Totals").Range("A14:O" & (13 + (NumberOfProducts - 1)) + (NumberOfProducts * 33)).Copy
    
    ThisWorkbook.ActiveSheet.Range("B12").PasteSpecial Paste:=xlPasteValues
    
    
    ' not sure what's happening here or where is't happening
    
    Range("B12").Select
    
    Application.CutCopyMode = False
    
    Range("B" & (NumberOfProducts * 33) + (11 + (NumberOfProducts - 1))).Select

    LastRow = ActiveCell.Row
    Range("P12").Select
    For x = 1 To LastRow
        If ActiveCell.Value <> "0" Then
            ActiveCell.Offset(1, 0).Select
        Else: Rows(ActiveCell.Row).EntireRow.Delete
        End If
    Next

End Sub

Note, to me anyway, the last part of the code isn't 100% clear so it probably needs a bit of work.
 
Upvote 0
There's no need to repeat code, try this.


' not sure what's happening here or where is't happening

Range("B12").Select

Application.CutCopyMode = False

Range("B" & (NumberOfProducts * 33) + (11 + (NumberOfProducts - 1))).Select

LastRow = ActiveCell.Row
Range("P12").Select
For x = 1 To LastRow
If ActiveCell.Value <> "0" Then
ActiveCell.Offset(1, 0).Select
Else: Rows(ActiveCell.Row).EntireRow.Delete
End If
Next

End Sub
[/code]

Note, to me anyway, the last part of the code isn't 100% clear so it probably needs a bit of work.

Thanks for this. I wasn't at work yesterday so testing now. The last bit of code that you weren't sure about looks atthe data pasted and removes blank lines or lines where the total in column P is zero. That bit works fine :)
 
Upvote 0
So, i no longer get any runtime errors, which is ace.. thanks for that, but, when the workbook opens, the code just ends so everything after "Set wbk = Workbooks.Open(FileToOpen)" doesn't execute
 
Upvote 0
update.. it actually breaks before the code where it removes zero totals.. so the data is pasted in but zero rows not removed. I think it's got something to do with the time it takes to open the other wbk as when i step through, it works perfectly
 
Upvote 0
So what code do you have now?

Did you change the part that I didn't change so that it referred to the correct workbook/worksheet?
 
Upvote 0
Thank you so much for your help
so i know you said not to repeat code, but i couldn't get this to work otherwise.
I should point out that if the workbook was already open then it all works perfectly.. but when the wbk needs to be opened, then the last bit of the code where zero total lines are removed, does not execute.
I first tried putting in a time delay after "~.open" to give it time to finish opening, but that did nothing. even though stepping through and waiting for the open to complete worked fine. The open took about 30secs so i set the delay to 1 minute.

As an addition to my original code, I wanted any workbook that needed opening to be closed afterwards.. so i added an if block to handle that using a variable that is given a value of "no" if the book needed opening and repeated the delete rows code in there.

This worked but again, would rather not repeat code if poss.

Thanks again

here's the full code as it stands

Code:
Sub ImportTotals(MyFolder, ListBox1)
Dim wbk As Workbook
Dim NumberOfProducts As Long
Dim FileToOpen As String
Dim LastRow As Long
Dim WasItOpen As String


    Application.ScreenUpdating = False


    FileToOpen = MyFolder & "\" & ListBox1


    For Each wbk In Workbooks
        If wbk.FullName = FileToOpen Then
            Exit For
        End If
    Next
    
    ' if workbook isn't open already open it
    If wbk Is Nothing Then
    WasItOpen = "no"
        Set wbk = Workbooks.Open(FileToOpen)
    '    Application.Wait (Now + TimeValue("0:01:00"))
    End If


    With wbk
        .Sheets("Overview").Range("J70").Formula = "=COUNTIFS(J63:J68,""<>*PRODUCT*"",J63:J68,""<>"")"
        NumberOfProducts = .Sheets("Overview").Range("J70").Value
        .Sheets("Overview").Range("J70").clear
    End With
    
    ThisWorkbook.ActiveSheet.Range("F10").Value = NumberOfProducts
    
    wbk.Sheets("Product Totals").Range("A14:O" & (13 + (NumberOfProducts - 1)) + (NumberOfProducts * 33)).Copy
    
    ThisWorkbook.ActiveSheet.Range("B12").PasteSpecial Paste:=xlPasteValues
    
    
  
    
    Range("B12").Select
    
    Application.CutCopyMode = False
    
    Range("B" & (NumberOfProducts * 33) + (11 + (NumberOfProducts - 1))).Select


    LastRow = ActiveCell.Row
    Range("P12").Select
    For x = 1 To LastRow
        If ActiveCell.Value <> "0" Then
            ActiveCell.Offset(1, 0).Select
        Else: Rows(ActiveCell.Row).EntireRow.Delete
        End If
    Next
    
    If WasItOpen = "no" Then
    Application.DisplayAlerts = False
    wbk.Close
    Application.DisplayAlerts = True
    'repeated code start
        Range("B12").Select
    
    Application.CutCopyMode = False
    
    Range("B" & (NumberOfProducts * 33) + (11 + (NumberOfProducts - 1))).Select


    LastRow = ActiveCell.Row
    Range("P12").Select
    For x = 1 To LastRow
        If ActiveCell.Value <> "0" Then
            ActiveCell.Offset(1, 0).Select
        Else: Rows(ActiveCell.Row).EntireRow.Delete
        End If
    Next
    'repeated code end
    
    End If
    ThisWorkbook.Activate




End Sub
 
Upvote 0
oooh.. i didn't.. i thought it was referring to the right book as it works fine when the other workbook is open already
 
Upvote 0

Forum statistics

Threads
1,215,427
Messages
6,124,830
Members
449,190
Latest member
rscraig11

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top