Error in VBA Code

A

a9hussai

New Member
Joined
Mar 1, 2019
Messages
3
where am i going wrong? I am getting error 1004 Application-define or object define error. I believe the error is when the "DO While" loop starts. Any help please? It doesn't highlight any code so I could use a hint.

The idea is to have a button in an Excel Workbook ("Do Stuff"), which opens all excel files in a specific folder (in the background) and extracts specific data from each workbook into a NEW workbook and saves it in a specifc folder.

The code worked when the final destination workbook had the VBA code button in it (ie. ThisWorkbook.SaveAs). However, I want to move the VBA Code / Button in the DO STUFF workbook and make it call other workbooks. But now I get an error and I don't know why. Help?


Code: 
Option Explicit
Option Base 1


Sub SAVE()
  Dim FileNames() As Variant, WName As String, nw As Integer, Folder As String, wB As Workbook, FileName As String, wCell As Integer, wB2 As Workbook
  Dim i As Integer, xlApp As Application, Sh As Object, sheet As Excel.Worksheet, wFind As Range, wFind2 As Range, wFind3 As Range, wFindFinal As Range
  Dim bags As Integer, weight_bags As Integer, sacs As Integer, weight_sacs As Integer, wbOpen As Workbook
  


  Set xlApp = CreateObject("Excel.Application")
  
    bags = 0
    weight_bags = 0
    sacs = 0
    weight_sacs = 0
  
  Workbooks.Open FileName:="\\PHILBURNSQL\Philburn\New Inbound Coffee Reports\Test\MASTER MP INVOICE.xls"
  
  Workbooks("MASTER MP INVOICE").SaveAs FileName:="\\PHILBURNSQL\Philburn\New Inbound Coffee Reports\Test\GI" & _
    Format(Now() - 1, "ddmmyy"), FileFormat:=xlOpenXMLWorkbook, Password:="", _
    WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
    
    WName = ActiveWorkbook.Name
    Set wB2 = Workbooks(WName)
    wB2.Sheets("Sheet1").Range("A17:G31").ClearContents
    wB2.Sheets("Sheet1").Range("F8").Value = "GI" & _
    Format(Now() - 1, "ddmmyy")
    wB2.Sheets("Sheet1").Range("F9").Value = "" & _
    Format(Now() - 1, "dd-Mmm-yy")
    
    wCell = 17
    
        Folder = "\\PHILBURNSQL\Philburn\New Inbound Coffee Reports\Test"
    FileName = Dir(Folder & "\*.xlsx")
    
    Do While FileName <> ""
    
       ' Set xlApp = CreateObject("Excel.Application")
               xlApp.Visible = False
        
        Set wB = xlApp.Workbooks.Open("\\PHILBURNSQL\Philburn\New Inbound Coffee Reports\Test" & FileName)
        Set sheet = wB.Worksheets("Step 1 -Inbound Entry Info")
        
        sheet.Activate
        Set wFind = wB.Sheets("Step 1 -Inbound Entry Info").Range("C6:C28").Find(What:="No weigh")
        Set wFind2 = wB.Sheets("Step 1 -Inbound Entry Info").Range("C6:C28").Find(What:="no weigh")
        Set wFind3 = wB.Sheets("Step 1 -Inbound Entry Info").Range("C6:C28").Find("NO WEIGH")
        
        If sheet.Range("B19").Value > 30 And wFind Is Nothing And wFind2 Is Nothing And wFind3 Is Nothing Then
            wB2.Sheets("Sheet1").Range("A" & wCell).Value = sheet.Range("B7").Value
            wB2.Sheets("Sheet1").Range("B" & wCell).Value = sheet.Range("B8").Value
            wB2.Sheets("Sheet1").Range("C" & wCell).Value = sheet.Range("B14").Value
            wB2.Sheets("Sheet1").Range("D" & wCell).Value = sheet.Range("B17").Value
            wB2.Sheets("Sheet1").Range("F" & wCell).Value = sheet.Range("B9").Value
            wB2.Sheets("Sheet1").Range("G" & wCell).Value = sheet.Range("B13").Value
            wB2.Sheets("Sheet1").Range("E" & wCell).Value = sheet.Range("B19").Value
            
            weight_bags = weight_bags + wB2.Sheets("Sheet1").Range("E" & wCell).Value
            wCell = wCell + 1
            
        ElseIf sheet.Range("B19").Value > 30 Then
            wB2.Sheets("Sheet1").Range("A" & wCell).Value = sheet.Range("B7").Value
            wB2.Sheets("Sheet1").Range("B" & wCell).Value = sheet.Range("B8").Value
            wB2.Sheets("Sheet1").Range("C" & wCell).Value = sheet.Range("B14").Value
            wB2.Sheets("Sheet1").Range("D" & wCell).Value = sheet.Range("B17").Value
            wB2.Sheets("Sheet1").Range("F" & wCell).Value = sheet.Range("B9").Value
            wB2.Sheets("Sheet1").Range("G" & wCell).Value = sheet.Range("B13").Value
            wB2.Sheets("Sheet1").Range("E" & wCell).Value = sheet.Range("B19").Value
            wB2.Sheets("Sheet1").Range("C" & wCell).Value = "*" & wB2.Sheets("Sheet1").Range("C" & wCell).Value
        
            bags = bags + wB2.Sheets("Sheet1").Range("E" & wCell).Value
            wCell = wCell + 1
                   
                   End If
                   
                   wB2.Sheets("Sheet1").Range("C17:C31").Select
            Selection.Sort Key1:=Range("C17:C31"), Order1:=xlDescending, _
                           Header:=xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
        
        wB.Close
        xlApp.Quit
        Set wB = Nothing
        Set xlApp = Nothing
        Set sheet = Nothing


        FileName = Dir
    Loop
    
    Folder = "\\PHILBURNSQL\Philburn\New Inbound Coffee Reports\Test"
    FileName = Dir(Folder & "\*.xlsx")
    
    Do While FileName <> ""
    
        Set xlApp = CreateObject("excel.Application")
               xlApp.Visible = False
        
        Set wB = xlApp.Workbooks.Open("\\PHILBURNSQL\Philburn\New Inbound Coffee Reports\Test" & FileName)
        Set sheet = wB.Worksheets("Step 1 -Inbound Entry Info")
        
        sheet.Activate
        Set wFind = wB.Sheets("Step 1 -Inbound Entry Info").Range("C6:C28").Find(What:="No weigh")
        Set wFind2 = wB.Sheets("Step 1 -Inbound Entry Info").Range("C6:C28").Find(What:="no weigh")
        Set wFind3 = wB.Sheets("Step 1 -Inbound Entry Info").Range("C6:C28").Find("NO WEIGH")
        
        If sheet.Range("B19").Value < 30 And wFind Is Nothing And wFind2 Is Nothing And wFind3 Is Nothing Then
            wB2.Sheets("Sheet1").Range("A" & wCell).Value = sheet.Range("B7").Value
            wB2.Sheets("Sheet1").Range("B" & wCell).Value = sheet.Range("B8").Value
            wB2.Sheets("Sheet1").Range("C" & wCell).Value = sheet.Range("B14").Value
            wB2.Sheets("Sheet1").Range("D" & wCell).Value = sheet.Range("B17").Value
            wB2.Sheets("Sheet1").Range("F" & wCell).Value = sheet.Range("B9").Value
            wB2.Sheets("Sheet1").Range("G" & wCell).Value = sheet.Range("B13").Value
            wB2.Sheets("Sheet1").Range("E" & wCell).Value = sheet.Range("B19").Value
            
            weight_sacs = weight_sacs + wB2.Sheets("Sheet1").Range("E" & wCell).Value
            wCell = wCell + 1
            
        ElseIf sheet.Range("B19").Value < 30 Then
            wB2.Sheets("Sheet1").Range("A" & wCell).Value = sheet.Range("B7").Value
            wB2.Sheets("Sheet1").Range("B" & wCell).Value = sheet.Range("B8").Value
            wB2.Sheets("Sheet1").Range("C" & wCell).Value = sheet.Range("B14").Value
            wB2.Sheets("Sheet1").Range("D" & wCell).Value = sheet.Range("B17").Value
            wB2.Sheets("Sheet1").Range("F" & wCell).Value = sheet.Range("B9").Value
            wB2.Sheets("Sheet1").Range("G" & wCell).Value = sheet.Range("B13").Value
            wB2.Sheets("Sheet1").Range("E" & wCell).Value = sheet.Range("B19").Value
            wB2.Sheets("Sheet1").Range("C" & wCell).Value = "*" & wB2.Sheets("Sheet1").Range("C" & wCell).Value
            
            sacs = sacs + wB2.Sheets("Sheet1").Range("E" & wCell).Value
            wCell = wCell + 1
            
            End If
                   
            wB2.Sheets("Sheet1").Range("C" & wCell & ":C31").Select
            Selection.Sort Key1:=Range("C" & wCell & ":C31"), Order1:=xlDescending, _
                           Header:=xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
        wB.Close
        xlApp.Quit
        
        Set wB = Nothing
        Set xlApp = Nothing
        Set sheet = Nothing


        FileName = Dir
        
    Loop
             
            wB2.Sheets("Sheet1").Range("A17:G31").Font.Name = "Trebuchet MS"
            wB2.Sheets("Sheet1").Range("A17:G31").Font.FontStyle = "Regular"
            wB2.Sheets("Sheet1").Range("A17:G31").Font.Size = 8
            
            wB2.Sheets("Sheet1").Range("A35").Value = bags + weight_bags
            wB2.Sheets("Sheet1").Range("A37").Value = weight_bags
            wB2.Sheets("Sheet1").Range("A39").Value = sacs + weight_sacs
            wB2.Sheets("Sheet1").Range("A41").Value = weight_sacs
            
            
    
End Sub
 
Last edited by a moderator:

Excel Facts

How to fill five years of quarters?
Type 1Q-2023 in a cell. Grab the fill handle and drag down or right. After 4Q-2023, Excel will jump to 1Q-2024. Dash can be any character.
Sort by date Sort by votes
Code: 
xlApp.Quit
Set xlApp = Nothing
This code has to be after the "Loop" not inside the loop. Not sure why you need to create another XL application when U already are using one? HTH. Dave
 
Upvote 0
NdNoviceHlp said:
Code: 
xlApp.Quit
Set xlApp = Nothing
This code has to be after the "Loop" not inside the loop. Not sure why you need to create another XL application when U already are using one? HTH. Dave
Click to expand...

I am still getting the same error. See my edited code please. Appreciate it!

Option Explicit
Option Base 1


Sub SAVE()
Dim FileNames() As Variant, WName As String, nw As Integer, Folder As String, wB As Workbook, FileName As String, wCell As Integer, wB2 As Workbook
Dim i As Integer, xlApp As Application, Sh As Object, sheet As Excel.Worksheet, wFind As Range, wFind2 As Range, wFind3 As Range, wFindFinal As Range
Dim bags As Integer, weight_bags As Integer, sacs As Integer, weight_sacs As Integer


Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = False

bags = 0
weight_bags = 0
sacs = 0
weight_sacs = 0

Workbooks.Open FileName:="\\PHILBURNSQL\Philburn\New Inbound Coffee Reports\Test\MASTER MP INVOICE.xls"

Workbooks("MASTER MP INVOICE").SaveAs FileName:="\\PHILBURNSQL\Philburn\New Inbound Coffee Reports\Test\GI" & _
Format(Now() - 1, "ddmmyy"), FileFormat:=xlOpenXMLWorkbook, Password:="", _
WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False

WName = ActiveWorkbook.Name
Set wB2 = Workbooks(WName)
wB2.Sheets("Sheet1").Range("A17:G31").ClearContents
wB2.Sheets("Sheet1").Range("F8").Value = "GI" & _
Format(Now() - 1, "ddmmyy")
wB2.Sheets("Sheet1").Range("F9").Value = "" & _
Format(Now() - 1, "dd-Mmm-yy")

wCell = 17

Folder = "\\PHILBURNSQL\Philburn\New Inbound Coffee Reports\Test"
FileName = Dir(Folder & "\*.xlsx")

Do While FileName <> ""

Set wB = xlApp.Workbooks.Open("\\PHILBURNSQL\Philburn\New Inbound Coffee Reports\Test" & FileName)
Set sheet = wB.Worksheets("Step 1 -Inbound Entry Info")

sheet.Activate
Set wFind = wB.Sheets("Step 1 -Inbound Entry Info").Range("C6:C28").Find(What:="No weigh")
Set wFind2 = wB.Sheets("Step 1 -Inbound Entry Info").Range("C6:C28").Find(What:="no weigh")
Set wFind3 = wB.Sheets("Step 1 -Inbound Entry Info").Range("C6:C28").Find("NO WEIGH")

If sheet.Range("B19").Value > 30 And wFind Is Nothing And wFind2 Is Nothing And wFind3 Is Nothing Then
wB2.Sheets("Sheet1").Range("A" & wCell).Value = sheet.Range("B7").Value
wB2.Sheets("Sheet1").Range("B" & wCell).Value = sheet.Range("B8").Value
wB2.Sheets("Sheet1").Range("C" & wCell).Value = sheet.Range("B14").Value
wB2.Sheets("Sheet1").Range("D" & wCell).Value = sheet.Range("B17").Value
wB2.Sheets("Sheet1").Range("F" & wCell).Value = sheet.Range("B9").Value
wB2.Sheets("Sheet1").Range("G" & wCell).Value = sheet.Range("B13").Value
wB2.Sheets("Sheet1").Range("E" & wCell).Value = sheet.Range("B19").Value

weight_bags = weight_bags + wB2.Sheets("Sheet1").Range("E" & wCell).Value
wCell = wCell + 1

ElseIf sheet.Range("B19").Value > 30 Then
wB2.Sheets("Sheet1").Range("A" & wCell).Value = sheet.Range("B7").Value
wB2.Sheets("Sheet1").Range("B" & wCell).Value = sheet.Range("B8").Value
wB2.Sheets("Sheet1").Range("C" & wCell).Value = sheet.Range("B14").Value
wB2.Sheets("Sheet1").Range("D" & wCell).Value = sheet.Range("B17").Value
wB2.Sheets("Sheet1").Range("F" & wCell).Value = sheet.Range("B9").Value
wB2.Sheets("Sheet1").Range("G" & wCell).Value = sheet.Range("B13").Value
wB2.Sheets("Sheet1").Range("E" & wCell).Value = sheet.Range("B19").Value
wB2.Sheets("Sheet1").Range("C" & wCell).Value = "*" & wB2.Sheets("Sheet1").Range("C" & wCell).Value

bags = bags + wB2.Sheets("Sheet1").Range("E" & wCell).Value
wCell = wCell + 1

End If

wB2.Sheets("Sheet1").Range("C17:C31").Select
Selection.Sort Key1:=Range("C17:C31"), Order1:=xlDescending, _
Header:=xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

wB.Close
Set wB = Nothing
Set sheet = Nothing
FileName = Dir

Loop

xlApp.Quit
Set xlApp = Nothing

Folder = "\\PHILBURNSQL\Philburn\New Inbound Coffee Reports\Test"
FileName = Dir(Folder & "\*.xlsx")

Do While FileName <> ""

Set wB = xlApp.Workbooks.Open("\\PHILBURNSQL\Philburn\New Inbound Coffee Reports\Test" & FileName)
Set sheet = wB.Worksheets("Step 1 -Inbound Entry Info")

sheet.Activate
Set wFind = wB.Sheets("Step 1 -Inbound Entry Info").Range("C6:C28").Find(What:="No weigh")
Set wFind2 = wB.Sheets("Step 1 -Inbound Entry Info").Range("C6:C28").Find(What:="no weigh")
Set wFind3 = wB.Sheets("Step 1 -Inbound Entry Info").Range("C6:C28").Find("NO WEIGH")

If sheet.Range("B19").Value < 30 And wFind Is Nothing And wFind2 Is Nothing And wFind3 Is Nothing Then
wB2.Sheets("Sheet1").Range("A" & wCell).Value = sheet.Range("B7").Value
wB2.Sheets("Sheet1").Range("B" & wCell).Value = sheet.Range("B8").Value
wB2.Sheets("Sheet1").Range("C" & wCell).Value = sheet.Range("B14").Value
wB2.Sheets("Sheet1").Range("D" & wCell).Value = sheet.Range("B17").Value
wB2.Sheets("Sheet1").Range("F" & wCell).Value = sheet.Range("B9").Value
wB2.Sheets("Sheet1").Range("G" & wCell).Value = sheet.Range("B13").Value
wB2.Sheets("Sheet1").Range("E" & wCell).Value = sheet.Range("B19").Value

weight_sacs = weight_sacs + wB2.Sheets("Sheet1").Range("E" & wCell).Value
wCell = wCell + 1

ElseIf sheet.Range("B19").Value < 30 Then
wB2.Sheets("Sheet1").Range("A" & wCell).Value = sheet.Range("B7").Value
wB2.Sheets("Sheet1").Range("B" & wCell).Value = sheet.Range("B8").Value
wB2.Sheets("Sheet1").Range("C" & wCell).Value = sheet.Range("B14").Value
wB2.Sheets("Sheet1").Range("D" & wCell).Value = sheet.Range("B17").Value
wB2.Sheets("Sheet1").Range("F" & wCell).Value = sheet.Range("B9").Value
wB2.Sheets("Sheet1").Range("G" & wCell).Value = sheet.Range("B13").Value
wB2.Sheets("Sheet1").Range("E" & wCell).Value = sheet.Range("B19").Value
wB2.Sheets("Sheet1").Range("C" & wCell).Value = "*" & wB2.Sheets("Sheet1").Range("C" & wCell).Value

sacs = sacs + wB2.Sheets("Sheet1").Range("E" & wCell).Value
wCell = wCell + 1

End If

wB2.Sheets("Sheet1").Range("C" & wCell & ":C31").Select
Selection.Sort Key1:=Range("C" & wCell & ":C31"), Order1:=xlDescending, _
Header:=xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
wB.Close
Set wB = Nothing
Set sheet = Nothing
FileName = Dir

Loop

xlApp.Quit
Set xlApp = Nothing

wB2.Sheets("Sheet1").Range("A17:G31").Font.Name = "Trebuchet MS"
wB2.Sheets("Sheet1").Range("A17:G31").Font.FontStyle = "Regular"
wB2.Sheets("Sheet1").Range("A17:G31").Font.Size = 8

wB2.Sheets("Sheet1").Range("A35").Value = bags + weight_bags
wB2.Sheets("Sheet1").Range("A37").Value = weight_bags
wB2.Sheets("Sheet1").Range("A39").Value = sacs + weight_sacs
wB2.Sheets("Sheet1").Range("A41").Value = weight_sacs

End Sub
 
Upvote 0
It may not have anything to do with the error you are getting, but you should NEVER use reserved words (name of existing functions, properties, methods, etc) as the names of your procedures or variables. This can cause unexpected results and errors!

So you should not use "SAVE" as the name of your prcoedure. Change it to something like "MySave".
 
Upvote 0
U Have quit the XlApp and set it to nothing after the first loop and then...
Code: 
Set wB = xlApp.Workbooks.Open("\\PHILBURNSQL\Philburn\New Inbound Coffee Reports\Test" & FileName)
The XlApp is no longer available. Again, why are U creating a new application anyways? Dave
edit: I didn't see Joe's nb consideration
 
Last edited:
Upvote 0
NdNoviceHlp said:
U Have quit the XlApp and set it to nothing after the first loop and then...
Code: 
Set wB = xlApp.Workbooks.Open("\\PHILBURNSQL\Philburn\New Inbound Coffee Reports\Test" & FileName)
The XlApp is no longer available. Again, why are U creating a new application anyways? Dave
edit: I didn't see Joe's nb consideration
Click to expand...

Honestly, I wanted to figure out how to open excel workbooks in the background. My code would open them and then close them. I googled it and came across this xlApp code. I implemented it and it worked. Now I'm tweaking it and it doesn't work. Can you explain to me what your question means? I would like to learn what needs to be done here.
 
Upvote 0
By using
Code: 
Set xlApp = CreateObject("Excel.Application")
you are creating a new instance of Excel & that is your problem.
The macro can only see workbooks that are open in the same instance.
You will need to remove that line & all references to xlApp
 
Upvote 0
You must log in or register to reply here.

Similar threads

R
  • Solved
SaveAs method not actually saving, wrong sheets being deleted (1004 Error)
Replies
4
Views
393
Alex Blakenburg
A
VBA learner ITG
  • Solved
Apple MAC Operating (file dialog object) code advice
Replies
1
Views
408
Tetra201
Tetra201
J
  • Question
VBA Script - Can't figure out one error...
2
Replies
15
Views
196
Peter_SSs
Peter_SSs
Z
  • Solved
Userform not adding data to destination file
Replies
3
Views
356
NdNoviceHlp
NdNoviceHlp
B
  • Solved
Object variable or with block variable not set
Replies
2
Views
526
Bagsy
B

Forum statistics

Threads
1,214,523
Messages
6,120,031
Members
448,940
Latest member
mdusw

Share this page

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