I have the below code which takes an XML file from a shared location and loads it into Excel. As soon as the file is opened, i get a "Run-time error '1004': Application-defined or object defined error" message.
Sub Load_XML()
Dim xml_file_path As String
Dim file_date As String
Worksheets("Start").Activate
file_date = Range("B1").Value
xml_file_path = "Y:\mydrive\" & file_date & "-000000_RREP1002.XML"
Workbooks.OpenXML Filename:= _
xml_file_path _
, LoadOption:=xlXmlLoadImportToList
Dim lstrow as Integer
Dim r as Range
lstrow = ActiveSheet.UsedRange.Rows.Count
Set r = Range("A2:AF & lstrow")
The code errors before the last line is executed, i.e. as soon as the OpenXML is done.
Any ideas please what could be causing this issue?
thanks!
I would refactor the code like below.
Public Sub Load_XML()
Dim wsStart As Worksheet
Set wsStart = ThisWorkbook.Worksheets("Start")
Dim file_date As String
file_date = wsStart.Range("B1").Value ' make sure all ranges have a worksheet specified!
Dim xml_file_path As String
xml_file_path = "Y:\mydrive\" & file_date & "-000000_RREP1002.XML"
Workbooks.OpenXML Filename:=xml_file_path, LoadOption:=xlXmlLoadImportToList
Dim lstRow As Long
lstRow = wsStart.UsedRange.Rows.Count
' I recommend a more reliable method to find the
Dim r As Range
Set r = wsStart.Range("A2:AF" & lstRow)
I recommend a more reliable method to find the last usted row than using
lstRow = wsStart.UsedRange.Rows.Count
It is better you use
lstRow = wsStart.Cells(wsStart.Rows.Count, "A").End(xlUp).Row
This will find the last used row in column A. Adjust the column to one that has always data and no blanks.
Related
This may sound a little bit dumb, but I have never experienced anything like this before with SolidWorks macro. I have written a SolidWorks macro that inserts a BOM table into an assembly saves it as excel, and adds needed formulas to an excel file. However it works 1 time out of 2- 1st time- all good, 2nd time I get an error- "Run-time error '1004' Method 'Rows' of object '_Global' Failed", 3rd time- all good, 4th time I get the same error and so on and so on. I'm really new to excel macro so I don't know if I'm missing something or just stupid?
Option Explicit
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swBOMAnnotation As SldWorks.BomTableAnnotation
Dim i As Integer
Dim nNumRow As Variant
Dim swTableAnn As SldWorks.TableAnnotation
Dim swAnn As SldWorks.Annotation
Dim swModelDocExt As SldWorks.ModelDocExtension
Dim template As String
Dim fType As String
Dim configuration As String
'excel variables
Dim x1App As Excel.Application
Dim xlWB As Excel.Workbook
Dim NextRow As Long
Sub main()
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swModelDocExt = swModel.Extension
template = "C:\Program Files\SOLIDWORKS Corp\SOLIDWORKS\lang\english\bom-all.sldbomtbt"
fType = swBomType_PartsOnly
configuration = "Default"
Set swBOMAnnotation = swModelDocExt.InsertBomTable3(template, 770, 240, fType, configuration, False, 2, True)
Dim path As String
path = Left(swModel.GetPathName, InStrRev(swModel.GetPathName, "\"))
Dim fpath As String
fpath = Format(path & "BOM\")
On Error Resume Next
MkDir (fpath)
On Error GoTo 0
Dim fName As String
fName = Format(fpath & "TEST.xls")
swBOMAnnotation.SaveAsExcel fName, False, False
Set swTableAnn = swBOMAnnotation
Set swAnn = swTableAnn.GetAnnotation
swAnn.Select3 False, Nothing
swModel.EditDelete
'Excel part
Set x1App = New Excel.Application
x1App.Visible = True
Set xlWB = x1App.Workbooks.Open(fName)
With Range("G3:G" & Cells(Rows.Count, "C").End(xlUp).Row)
.Formula = "=C3*F3"
End With
NextRow = Range("G" & Rows.Count).End(xlUp).Row + 1
Range("G" & NextRow).Formula = "=SUM(G2:G" & NextRow - 1 & ")"
End Sub
Not sure what's causing the behavior you're describing but here are a few thoughts that might point you in the right direction.
Objects in macros are persistent, meaning swModel (and other objects) will still exist after the macro is run. This is why you need to set it to 'Nothing' before using it again.
"Rows" is not defined anywhere so I'm surprised that code works at all. It must be late binding it to something... Rows is a method for an excel range but you're not using it that way. (range.Rows)
Try getting the row count explicitly in a double and using that instead. I suspect that will fix your issue.
you all were a great help with my last issue, so I figured Id ask another question. I am currently creating a code that keeps track of a mailroom's inventory. The code that I am working on is a textbox that whenever something is typed, it copies the value to the excel and it triggers an advanced search. I want to use xlfiltercopy to prevent visual damage to the excel sheet and so it is easier to update the listbox in the userform with the filtered information. Please let me know if you can find a reason that the error "AdvancedFilter method of Range class failed"
EDIT: If possible, I would like to email the entire excel to someone to see if the program works on another computer. I cannot physically think of a way to get it to work. Please consider it!
' Input on the 2nd page
' This code will update the list box below automatically as you type a name
Private Sub TextBox5_Change()
If Me.TextBox5.Value = "" Then
Exit Sub
End If
Dim wks As Worksheet
Set wks = ThisWorkbook.Sheets("Mail_Inventory")
Dim rgData As Range
Dim rgCriteria As Range
Dim rgOutput As Range
Dim currentinventory As Long
Dim filteredcurrent As Long
Dim temp As Long
temp = wks.Range("AS1").Value
If temp > 0 Then
wks.ListObjects("CurrentFiltered").DataBodyRange.Rows.Delete
End If
wks.Range("AP6").Value = Me.TextBox5.Value
currentinventory = wks.Range("A1").Value
'Set rgData = ThisWorkbook.Worksheets("Mail_Inventory").Range("A2:H" & currentinventory + 2)
'Set rgCriteria = ThisWorkbook.Worksheets("Mail_Inventory").Range("AP5:AP6")
'Set rgOutput = ThisWorkbook.Worksheets("Mail_Inventory").Range("AS2:AZ2")
Set rgData = Range("A2:H" & currentinventory + 2)
Set rgCriteria = Range("AP5:AP6")
Set rgOutput = Range("AS2:AZ2")
rgData.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=rgCriteria, CopytoRange:=rgOutput
'wks.Range("A2:H" & currentinventory + 2).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=wks.Range("AP5:AP6"), CopyToRange:=wks.Range("AS2:AZ2")
'filteredcurrent = wks.Range("AS1").Value
'Me.ListBox2.Clear
'Me.ListBox2.RowSource = wks.Range("AS2:AV" & filteredcurrent + 2)
I got this error and I tried to fixed with many solution, but I don't know why this error is happening. Could you help me to fix this problem? In this code I have twice used VLookup function same source, different only Worksheet name and column. Another one can compile this code and don't have any error.
I'm doing, VLookup item on column B of worksheet "ImportData2" match with column A of worksheet "Noallocate" if match show result of VLookup at column Q of worksheet "ImportData2"
get this error
Source code:
'Vlook up function no import
Dim Vrow1 As Long
Dim myLookupValue1 As String
Dim myFirstColumn1 As Long
Dim myLastColumn1 As Long
Dim myColumnIndex1 As Long
Dim myFirstRow1 As Long
Dim myLastRow1 As Long
Dim myVLookupResult1 As String
Dim myTableArray1 As Range
For Vrow1 = 2 To 99999
myLookupValue1 = Workbooks("ExpenseData.xlsm").Worksheets("ImportData2").Range("B" & Vrow).Value
myFirstColumn1 = 1
myLastColumn1 = 2
myColumnIndex1 = 2
myFirstRow1 = 2
myLastRow1 = Workbooks("ExpenseData.xlsm").Worksheets("Noallocate").Range("b1").End(xlDown).Row
With Workbooks("ExpenseData.xlsm").Worksheets("Noallocate")
Set myTableArray1 = .Range(.Cells(myFirstRow1, myFirstColumn1), .Cells(myLastRow1, myLastColumn1))
End With
myVLookupResult1 = WorksheetFunction.VLookup(myLookupValue1, myTableArray1, myColumnIndex1, False) 'xxx
Workbooks("ExpenseData.xlsm").Worksheets("ImportData").Range("Q" & Vrow).Value = myVLookupResult1 'xxx
Next 'end function no import
Try the next code, please. It would be a good habit to have 'Option Explicit' on top of your module. This will oblige you to declare all variables. It looks, your code iterates using Vrow1 but inside the loop you used Vrow... I discovered it only after trying to make your code a little friendlier. It is not good to use big variables name instead of 1, 2. This can only make the code more difficult to be understood by looking at it. As short it would be, as easy to be understood and debugged:
Sub testVlookup()
Dim Wb As Workbook, Vrow1 As Long, lastRDat As Long, wsNoall As Worksheet
Dim wsImpD2 As Worksheet, myLookupValue1 As String, myLastRow1 As Long
Dim myVLookupResult1 As String, myTableArray1 As Range
Set Wb = Workbooks("ExpenseDataMcframe.xlsm")
Set wsNoall = Wb.Worksheets("Noallocate")
Set wsImpD2 = Wb.Worksheets("ImportData2")
myLastRow1 = wsNoall.Range("b" & Rows.count).End(xlUp).Row
lastRDat = wsImpD2.Range("B" & Rows.count).End(xlUp).Row
For Vrow1 = 2 To lastRDat
myLookupValue1 = wsImpD2.Range("B" & Vrow1).value
Set myTableArray1 = wsNoall.Range(wsNoall.Cells(2, 1), wsNoall.Cells(myLastRow1, 2))
On Error Resume Next 'for the case when lookup_value is not found
myVLookupResult1 = WorksheetFunction.VLookup(myLookupValue1, myTableArray1, 2, False) 'xxx
If Err.Number <> 0 Then
Err.Clear: On Error GoTo 0
Wb.Worksheets("ImportData").Range("Q" & Vrow1).value = "Not a mach"
Else
Wb.Worksheets("ImportData").Range("Q" & Vrow1).value = myVLookupResult1 'xxx
End If
On Error GoTo 0
Next
End Sub
When the lookup_value is not found, the code will return (on Q:Q column) "Not a match" and you must check the specific code/whatever it is...
Tring to make the following code work. For some reason returns a Run-time error '1004': Application-defined or object-defined error.
The code is the following:
Sub UpdateLinks()
Dim lastFlight, lastMis, logBook, studentCode As String
Dim i, j, k, numRows As Integer
Dim wb0 As Workbook
Dim studentSheet As Worksheet
Set wb0 = ActiveWorkbook
Set studentSheet = wb0.Worksheets("STUDENTS")
numRows = studentSheet.Range("A5").CurrentRegion.Rows.Count
studentCode = studentSheet.Cells(8, 2).Value
lastFlight = "=MAIOR('\\server\# FLTLOG_EXPORT\[" & studentCode & ".xlsx]Status'!$A$3:$A$219;1)"
lastMis = "=PROC(2;1/(1-É.CÉL.VAZIA('\\server\# FLTLOG_EXPORT\[" & studentCode & ".xlsx]Status'!$C$3:$C$230));'\\server\# FLTLOG_EXPORT\[" & studentCode & ".xlsx]Status'!$C$3:$C$230)"
logBook = "'\\server\# FLTLOG_EXPORT\[" & studentCode & ".xlsx]Desvios'!$Q$15"
ActiveSheet.Cells(8, 4).Formula = lastFlight
End Sub
The formulas are in Portuguese and MAIOR is LARGE, PROC is LOOKUP. The code stops in the:
ActiveSheet.Cells(8, 4).Formula = lastFlight
Please help. Kind regards.
First of all please note that if you declare
Dim i, j, k, numRows As Integer
only numRows is Integer but all the others are of type Variant. It is exactly the same as writing:
Dim i As Variant, j As Variant, k As Variant, numRows As Integer
In VBA you need to specify a type for every variable. Also Excel has more rows than fit into an Integer, so you must use Long instead. Also there is no benefit in using Integer in VBA so I recommend always to use Long instead:
Dim i As Long, j As Long, k As Long, numRows As Long
Same applies to your other multiple variables declared in one line.
Another recommendation is to avoid ActiveWorkbook and ActiveSheet if possible.
Note that ActiveWorkbook is the workbook that has focus / is on top. This can change easily by a single user click. What you probably meant to use is ThisWorkbook which is the workbook this VBA code is written in (and it never changes).
Instead of ActiveSheet.Cells specify the worbkook and worksheet explicitly for your Cells object. Like studentSheet.Cells or something similar.
To your actual issue
Note that the file studentCode & ".xlsx needs to be open if you want to use it in a formula.
Make sure you open it with
Dim wb As Workbook
Set wb = Workbooks.Open("\\server\# FLTLOG_EXPORT\" & studentCode & ".xlsx"
Then you can use it in your formula without the path:
lastFlight = "=MAIOR('[" & studentCode & ".xlsx]Status'!$A$3:$A$219;1)"
I have a list of files with the same structure and I want to extract some information from columns A, B, and C and print it to another workbook.
I found a way to do it for a single file, but now I don't understand how can I do it using the list of given files. I tried using collections, but it doesn't work.
Here's what I came up with:
Sub Pulsante1_Click()
Dim FileGeStar As Variant
Dim myCol As Collection
Set myCol = New Collection
myCol.Add "C:\Users\xxx\Desktop\articoli_def.xlsx"
myCol.Add "C:\Users\xxx\Desktop\pippo\SS20_def_ENG.xlsx"
For Each FileGeStar In myCol
Workbooks.Open Filename:=FileGeStar
FileGeStar = Application.ActiveWorkbook.Name
Dim Code As String
Dim Description As String
Dim FilePath As String
Dim i As Long
i = 2
While Range("A" & i) <> ""
FilePath = Application.ActiveWorkbook.Path
Code = Trim(Range("A" & i).Value)
Description = Trim(Range("B" & i).Value)
Workbooks("Report.xlsm").Worksheets(1).Range("A" & i).Value = FilePath
Workbooks("Report.xlsm").Worksheets(1).Range("B" & i).Value = Code
Workbooks("Report.xlsm").Worksheets(1).Range("C" & i).Value = Description
i = i + 1
Wend
Next FileGeStar
End Sub
What can I do?
This might look like an overkill, but I hope the code and comment's are self explanatory:
Option Explicit
Sub Pulsante1_Click()
Dim DestinationWorkbook As Workbook
Set DestinationWorkbook = ThisWorkbook 'I think report.xlsm is the workbook running the code
'if report.xlsm is not the workbook running the code then change thisworkbook for workbooks("Report.xlsm")
'add as many paths as you need to, another way would be to write them in a sheet and loop through to fill the array
Dim MyPaths As Variant
MyPaths = Array("C:\Users\xxx\Desktop\articoli_def.xlsx", "C:\Users\xxx\Desktop\pippo\SS20_def_ENG.xlsx")
'Declare a workbook variable for the source workbooks
Dim SourceWorkbook As Workbook
'Declare a long variable to loop through your path's array
Dim i As Long
'loop through the start to the end of your array (will increase as the array does)
For i = LBound(MyPaths) To UBound(MyPaths)
Set SourceWorkbook = OpenWorkbook(MyPaths(i)) 'this will set the workbook variable and open it
CopyData SourceWorkbook, DestinationWorkbook 'this will copy the data to your destination workbook
SourceWorkbook.Close , False
Set SourceWorkbook = Nothing
Next i
End Sub
Private Function OpenWorkbook(FullPath As String) As Workbook
Set OpenWorkbook = Workbooks.Open(FullPath, False, True)
End Function
Private Sub CopyData(wbO As Workbook, wbD As Workbook)
'this procedure calculates the last row of your source workbook and loops through all it's data
'later calls the AddDataToMasterWorkbook procedure to paste the data
With wbO.Sheets(1) 'Im assuming your source workbook has the data on sheet1
Dim LastRow As Long
LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
Dim FilePath As String
FilePath = wbO.Path
Dim Code As String
Dim Description As String
Dim C As Range
For Each C In .Range("A2:A" & LastRow) 'this will loop from A2 to the last row with data
Code = Trim(C)
Description = Trim(C.Offset(, 1))
AddDataToMasterWorkbook wbD, FilePath, Code, Description
Next C
End With
End Sub
Private Sub AddDataToMasterWorkbook(wb As Workbook, FilePath As String, Code As String, Description As String)
'This procedure calculates the last row without data and adds the items you need every time
With wb.Sheets(1)
Dim LastRow As Long
LastRow = .Cells(Rows.Count, "A").End(xlUp).Row + 1
.Range("A" & LastRow) = FilePath
.Range("B" & LastRow) = Code
.Range("C" & LastRow) = Description
End With
End Sub
To loop though files, you can indeed use a collection, or an array, you can also loop through all files in directory with certain extension, or partial file name. Check out DIR function.
Best not to use ActiveWorkbook, better approach would be to set a workbook object like so: Set wb = Workbooks.Open(fullPathToYourWorkbook).
For what you're doing, there's no need to go row by row, much more efficient way would be to copy entire range, not only it's a lot quicker but also it's only 1 line of code; assuming your destination is ThisWorkbook.Sheets(1) and wb object is set: wb.Range("A:C").Copy Destination:=Thisworkbook.Sheets(1).Range("A:C"). If you need to edit copied data (trim or whatever) consider Range Replace method.
However, if you want to go row by row for whatever reason, as BigBen mentioned in the comment - get rid of While loop.
It's a good idea to set Application.ScreenUpdating to False when opening/closing workbooks, then back to True once it's all done. It will prevent user from accidentaly clicking something etc and will make it look like it's not opening any workbook.
Here's my approach (untested) assuming the workbook you want to copy data to is Workbooks("Report.xlsm").Worksheets(1):
Sub Pulsante1_Click()
'set workbook object for the destination workbook
set wb_dest = Workbooks("Report.xlsm").Worksheets(1)
'disable screen updating
Application.ScreenUpdating = False
For Each target_wb In Array("C:\Users\xxx\Desktop\articoli_def.xlsx", "C:\Users\xxx\Desktop\pippo\SS20_def_ENG.xlsx")
'set wb object and open workbook
Set wb = Workbooks.Open(target_wb)
'find last row in this workbooks in columns A:B (whichever is greater)
LastRow = wb.Range("A:B").Find(What:="*", After:=wb.Range("A1"), SearchDirection:=xlPrevious).row
'copy required data
wb.Range("A1:B" & LastRow).Copy Destination:=wb_dest.Range("B1:C" & LastRow)
'fill column A with path to the file
wb_dest.Range("A1:A" & LastRow).Value = wb.Path
'close workbook
wb.Close False
Next
'enable screen updating
Application.ScreenUpdating = True
End Sub
Obviously an array is not the best approach if you have loads of different files, collection would be a lot clearer to read and edit in the future, unless you want to create a dynamic array, but there's no need for that in my opinion. I didn't declare variables or write any error handling, it's a simple code just to point you in the right direction.
If you want to disable workbook events or/and alerts, you can set Application.DisplayAlerts and Application.EnableEvents to False temporarily.