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?
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: