I make a macro to open many files and do some operations like copy and paste in final file.
But I want when there is no file to skip the piece of code connected with this file:
'create variables'
FinalFile = "order.xls"
Obj1 = "order-obj1.xls"
Obj1Range = "E11"
......
Windows(Obj1).Activate
Range(MyRange).Select
Selection.Copy
Windows(FinalFile).Activate
Range(Obj1Range).Select
ActiveSheet.Paste
Windows(Obj1).Activate
ActiveWindow.Close
Windows(Obj2).Activate
Range(MyRange).Select
Selection.Copy
Windows(FinalFile).Activate
Range(Obj2Range).Select
ActiveSheet.Paste
Windows(Obj2).Activate
ActiveWindow.Close
If I can't open some file I recieve run time error 9. So my question is how to skip the code for Obj1 and proceed to Obj2?
I hope you can understand me...
Use the commmand Dir() to check whether the file exists.
e.g.
If Dir(Obj1) <> "" Then
Windows(Obj1).Activate
Range(MyRange).Select
Selection.Copy
Windows(FinalFile).Activate
Range(Obj1Range).Select
ActiveSheet.Paste
Windows(Obj1).Activate
ActiveWindow.Close
End If
Also, you probably want to put this code into a function so as not to repeat it, but that is another question.
UNTESTED
Here is how I would do it. Without using .SELECT/.ACTIVATE
Dim destwb As Workbook
Sub Sample()
Dim FinalFile As String
Dim Obj1 As String, Obj2 As String
Dim MyRange As String, Obj1Range As String, Obj1Rang2 As String
Dim wb As Workbook
'~~> Change as applicable
FinalFile = "order.xls"
Obj1 = "order-obj1.xls"
Obj2 = "order-obj2.xls"
Obj1Range = "E11"
Obj2Range = "E12"
MyRange = "A1"
Set destwb = Workbooks(FinalFile)
On Error Resume Next
Set wb = Workbooks(Obj1)
On Error GoTo 0
If Not wb Is Nothing Then
CopyRange wb, MyRange, Obj1Range
DoEvents
Set wb = Nothing
End If
On Error Resume Next
Set wb = Workbooks(Obj2)
On Error GoTo 0
If Not wb Is Nothing Then
CopyRange wb, MyRange, Obj2Range
DoEvents
Set wb = Nothing
End If
End Sub
Sub CopyRange(w As Workbook, r1 As String, r2 As String)
On Error GoTo Whoa
Dim ws As Worksheet, rng As Range
Set ws = w.Sheets(1)
Set rng = ws.Range(r1)
r1.Copy destwb.Sheets("Sheet1").Range(r2)
DoEvents
wb.Close savechanges:=False
Exit Sub
Whoa:
MsgBox Err.Description
End Sub
Related
I want below code to open a closed workbook and copy the values from the range StartRow and EndRow to active workbook.
I get
error 1004 "No such interface supported".
on line "xlBook.Sheets(ShName).Range(Cells(StartRow, 1), Cells(EndRow, 1)).Select"
When I run this code directly in the workbook I want to copy the data from, it works.
Sub GetDataFromClosedBook()
'copy data from closed workbook to active workbook
Dim xlApp As Application
Dim xlBook As Workbook
Dim sh As Object
Set xlApp = CreateObject("Excel.Application")
'Path source Wokrbook
Set xlBook = xlApp.Workbooks.Open("C:\Users\name\Desktop\EXCEL USEFUL DOSC\Missing Data Check New Process\Missing Data Reports\" & Sheets("Data Check").Range("C3").Value & ".xlsx")
xlApp.Visible = True
ShName = Sheets("Data Check").Range("C3").Value
With xlBook.Sheets(ShName)
StartRow = .Range("E:E").Find(what:="January-2020", after:=.Range("E1")).Row
EndRow = .Range("E:E").Find(what:="January-2020", after:=.Range("E1"), searchdirection:=xlPrevious).Row
'ThisWorkbook.Activate
xlBook.Sheets(ShName).Range("A2").Value = ShName
xlBook.Sheets(ShName).Range(Cells(StartRow, 1), Cells(EndRow, 1)).Select
'Sheets(ShName).Range(Cells(StartRow, 1), Cells(EndRow, 1)).Select
End With
xlApp.DisplayAlerts = False
xlBook.Close
xlApp.Quit
Set xlBook = Nothing
Set xlApp = Nothing
Set xlBook = ActiveWorkbook
Set sh = Sheets("Dealer_ID Check")
sh.Activate
Range("A1").Select
sh.Paste
End Sub
Putting all the comments together, your code so far could be refactoed as
Option Explicit
Sub GetDataFromClosedBook()
'copy data from closed workbook to active workbook
Dim wbData As Workbook
Dim wbDest As Workbook
Dim wsDataCheck As Worksheet
Dim wsDealerIDCheck As Worksheet
Dim wsReports As Worksheet
Dim ShName As String
Dim PthName As String
Dim FlName As String
Dim rStartRow As Range, rEndRow As Range
Dim rng As Range
Set wbDest = ActiveWorkbook ' not prefered, better to be explicit
Set wsDataCheck = wbDest.Worksheets("Data Check")
'Path source Wokrbook
PthName = "C:\Users\name\Desktop\EXCEL USEFUL DOSC\Missing Data Check New Process\Missing Data Reports\"
FlName = wsDataCheck.Range("C3").Value
ShName = wsDataCheck.Range("C3").Value
On Error Resume Next
Set wbData = Workbooks.Open(PthName & FlName & ".xlsx")
On Error GoTo 0
If wbData Is Nothing Then
' File didn't open
Exit Sub
End If
Set wsReports = Nothing
On Error Resume Next
Set wsReports = wbData.Worksheets(ShName)
On Error GoTo 0
If wsReports Is Nothing Then
' No such sheet
GoTo CleanUp
End If
With wsReports
Set rStartRow = .Range("E:E").Find(What:="January-2020", After:=.Range("E1"), LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlNext)
Set rEndRow = .Range("E:E").Find(What:="January-2020", After:=.Range("E1"), SearchDirection:=xlPrevious)
If rStartRow Is Nothing Or rEndRow Is Nothing Then
' Search term not found, What Now?
GoTo CleanUp
End If
.Range("A2").Value = ShName
Set rng = .Range(rStartRow, rEndRow)
' For debug purposes only
.Activate ' the worksheet
rng.Select ' the range
End With
Application.DisplayAlerts = False
' do you want to save the change you made to wbData?
wbData.Close True ' or wbData.Save False
Set wsDealerIDCheck = wbDest.Worksheets("Dealer_ID Check")
' continue ...
Exit Sub
CleanUp:
If Not wbData Is Nothing Then wbData.Close False
End Sub
The comments have pointed out the disassociation in your code many times. Your code uses implicit and explicit references to worksheets without performing any of the necessary checks to prevent errors.
The commenters we're being polite and didn't use strong terms, but I am not polite: ActiveSheet is not what you think it is.
What you think ActiveSheet is during design is practically never guaranteed to be ActiveSheet during run time. There are certainly times when they are but such certainties are rare unless you make the effort to code then into reality. All other times you should explicitly reference your ranges. Consider it a life saving skill
Let's assume you set a pointer to a workbook and you open it, whatever sheet it opens to becomes the ActiveSheet. Typically this is the sheet that was last viewed when the workbook was saved, but that is by no means guaranteed.
What is even less guaranteed, is your assumption that it will open to the "Data Check" sheet.
You can read from and write to the "Data Check" sheet all day long without caring if it is the ActiveSheet or not, but you can only Select a cell on it when it is the ActiveSheet.
The worksheet variableShName is set to the "Data Check" worksheet. At no point have you validated ShName as the ActiveSheet, but ShName must be the ActiveSheet to prevent an error on this line:
xlBook.Sheets(ShName).Range(Cells(StartRow, 1), Cells(EndRow, 1)).Select
So I had this error in word but as was pointed out "ActiveDocument" was the issue even though I only had one word application open. By changing to wdApp.ActiveDocument it resolved it. wdApp being my word.application object.
Is there a way to skip error "filename is not found" and move to the next file?
Sub CopyDataAndMoveDown()
Application.ScreenUpdating = False
Dim wb As Workbook: Set wb = ThisWorkbook
Dim ws As Worksheet: Set ws = wb.ActiveSheet
Dim rngToCopy As Range, rngToPaste As Range
Dim x As Long
Dim breakdown1
Dim breakdown As Worksheet: Set breakdown = wb.ActiveSheet
For x = 4 To 504 Step 6
With wb.Sheets("Sheet1")
breakdown1 = breakdown.Cells(9, x - 2)
End With
If IsEmpty(breakdown1) Then
Call MoveBelow
Else
With wb.Sheets("Sheet1")
Set rngToCopy = .Range(.Cells(4, x - 2), .Cells(24, x + 3))
Debug.Print rngToCopy.Address
End With
With wb.Sheets("Sheet2")
Set rngToPaste = .Range(.Cells(4, x - 2), .Cells(rngToCopy.Rows.Count + 3, x + 3))
Debug.Print rngToPaste.Address
End With
rngToPaste = rngToCopy.Value
End If
Next x
Application.ScreenUpdating = True
MsgBox "Valmis."
End Sub
Sub MoveBelow ()
Application.ScreenUpdating = False
Dim wb As Workbook: Set wb = ThisWorkbook
Dim ws As Worksheet: Set ws = wb.ActiveSheet
Dim rngToCopy As Range, rngToPaste As Range
Dim x As Long
Dim breakdown1
Dim breakdown As Worksheet: Set breakdown = wb.ActiveSheet
For x = 4 To 504 Step 6
With wb.Sheets("Sheet1")
breakdown1 = breakdown.Cells(9, x - 2)
End With
If IsEmpty(breakdown1) Then
' At this point when the macro meet again a empty cell
' it should keep moving from the same counted X
' but start the paste operation from 24 rows below.
Else
With wb.Sheets("Sheet1")
Set rngToCopy = .Range(.Cells(4, x - 2), .Cells(24, x + 3))
Debug.Print rngToCopy.Address
End With
With wb.Sheets("Sheet2")
Set rngToPaste = .Range(.Cells(28, x - 2), .Cells(rngToCopy.Rows.Count + 3, x + 3))
Debug.Print rngToPaste.Address
End With
rngToPaste = rngToCopy.Value
End If
Next x
Application.ScreenUpdating = True
MsgBox "Valmis."
End Sub
So when the macro is copying / pasting data from Sheet 1 to Sheet 2 and meets an empty cell it should keep going, copying next available data, but paste it 24 rows below.
--------Below the old question.
I have a VBA which is opening and closing file for that INDEX function get data. My problem is that. VBA is getting the filename from reference cell which contain the full path. But some of the reference cells are blanks/zeros and then the running VBA stops and give me error "filename is not found". Is there a way to skip that and move to next step?
Sub HaeReseptiTiedot()
Dim myfile As String
Dim myfile1 As String
Dim myfile2 As String
Dim myfile3 As String
Dim myfile4 As String
Dim myfile5 As String
Dim myfile6 As String
Dim myfile7 As String
Dim myfile8 As String
Dim myfile9 As String
myfile = Cells(19, 4).Value
myfile1 = Cells(19, 9).Value
myfile2 = Cells(19, 14).Value
myfile3 = Cells(19, 19).Value
myfile4 = Cells(19, 24).Value
myfile5 = Cells(19, 29).Value
myfile6 = Cells(19, 34).Value
myfile7 = Cells(19, 39).Value
myfile8 = Cells(19, 44).Value
myfile9 = Cells(19, 49).Value
Application.ScreenUpdating = False
Workbooks.Open Filename:=myfile, UpdateLinks:=0
ActiveWorkbook.Close False
Sheets("Aputaulukko 2").Select
Range("D16:G30").Select
Selection.Copy
Sheets("Aputaulukko 3").Select
Range("B4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Workbooks.Open Filename:=myfile1, UpdateLinks:=0
ActiveWorkbook.Close False
Sheets("Aputaulukko 2").Select
Range("I16:L30").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Aputaulukko 3").Select
Range("G4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
The best way I have found to handle this is to use the "On Error" statement. You can keep it really simple and use On Error Resume Next, which tells the code to skip the error entirely and move to the next statement (that does not have an error). The main issue with this is that it covers ALL errors, not just the specific one you are having issues with currently. It can make it hard to know if errors are occurring/if your code is functioning as you expect.
The other option, which can help avoid the issues mentioned above, is to use something like this:
On Error GoTo ErrH
'Main Body of Your Code
Exit Sub 'Use to avoid continuing on to the ErrH section.
ErrH:
'Some method for handling the error, such as a message box or other notification.
This usually isn't necessary with small chunks of code, but when you start combining your subs and functions it can be a life saver!
Good Luck!
Edit: You could/should also consider removing those blanks if they are not necessary for the sheet to work.
Here is a function that can check if a file exists:
'********************************************************************************************************************************
' To check if a particular file exists
' Set excelFile = False, if it is not an Excel file that is being checked
'********************************************************************************************************************************
Public Function isAnExistingFile(ByVal fileNameStr As Variant, Optional ByVal excelFile As Boolean = True) As Boolean
Dim wb As Workbook
isAnExistingFile = True
Err.Clear
On Error GoTo errHandler
If Not VarType(fileNameStr) = vbString Then
isAnExistingFile = False
ElseIf Len(fileNameStr) = 0 Then
isAnExistingFile = False
ElseIf Len(Dir(fileNameStr)) = 0 Then
isAnExistingFile = False
ElseIf ((GetAttr(fileNameStr) And vbDirectory) <> vbDirectory) = False Then
isAnExistingFile = False
Else
If excelFile Then
On Error Resume Next
Set wb = Application.Workbooks.Open(Filename:=fileNameStr, UpdateLinks:=0, ReadOnly:=True)
If wb Is Nothing Then isAnExistingFile = False
If Not wb Is Nothing Then
wb.Close False
Set wb = Nothing
End If
GoTo Out
End If
End If
errHandler:
If Not Err.Number = 0 Then isAnExistingFile = False
Out:
Err.Clear: On Error GoTo 0
End Function
I took the liberty to rewrite your code... i'm still not quite sure why you are openning and closing the workbook immediately, but in essence this is what your code does at the moment:
Option Explicit
Sub HaeReseptiTiedot()
Application.ScreenUpdating = False
Dim wbSource As Workbook
Dim wb As Workbook: Set wb = ThisWorkbook 'Or ActiveWorkbook or Workbooks("book name")
Dim ws As Worksheet: Set ws = wb.ActiveSheet 'Or wb.Sheets("Sheet Name")
Dim rngToCopy As Range, rngToPaste As Range
Dim X As Long
For X = 4 To 49 Step 5
On Error Resume Next
Set wbSource = Workbooks.Open(FileName:=ws.Cells(19, X), UpdateLinks:=0)
On Error GoTo 0
If Not wbSource Is Nothing Then
wbSource.Close False
With wb.Sheets("Aputaulukko 2")
Set rngToCopy = .Range(.Cells(16, X), .Cells(30, X + 3))
'Debug.Print rngToCopy.Address
End With
With wb.Sheets("Aputaulukko 3")
Set rngToPaste = .Range(.Cells(4, X - 2), .Cells(rngToCopy.Rows.Count + 3, X + 1))
'Debug.Print rngToPaste.Address
End With
rngToPaste = rngToCopy.Value
End If
Set wbSource = Nothing
Next X
Application.ScreenUpdating = True
End Sub
You could work around this by creating a second Sub that opens the file and handles the error if the file doesn't exist. That way you are still able to catch other Errors in the main Sub without going to next. Example:
Sub MainSub()
myFile1 = "C:\Temp\New1.xlsx"
myFile2 = "C:\Temp\New2.xlsx"
CheckAndOpen (myFile1)
CheckAndOpen (myFile2)
End Sub
Sub CheckAndOpen(myFileName As String)
On Error Resume Next
Workbooks.Open Filename:=myFileName
Debug.Print Err.Number, myFileName
End Sub
You could, alternatively, just put the following in your code:
If dir("FILENAME") <> "" Then
Add the rest of your code
End If
I usually run 3 or 4 for loops inside of each other with different variables to get the full path of each file, then put this to ensure I do not open files where there are blanks.
My macro is going through a folder and picking each Excel file and deleting the first tab which is named some_Accounts and then copy pasting data to the master workbook where the worksheet names match.
Getting the following error Method 'Name' of object '_Worksheet' on the following line of code
Set wsDst = wbDst.Worksheets(wsSrc.Name)
I made sure that the worksheet names are equal.
Sub ProjectMacro()
Dim wbDst As Workbook
Dim wsDst As Worksheet
Dim wbSrc As Workbook
Dim wsSrc As Worksheet
Dim MyPath As String
Dim strFilename As String
Dim lLastRow As Long
Dim LC As Long
Dim s As Worksheet, t As String
Dim i As Long, K As Long
K = Sheets.Count
Application.DisplayAlerts = False
Application.EnableEvents = False
Application.ScreenUpdating = False
Set wbDst = ThisWorkbook
MyPath = "C:\Users\Adam\Desktop\some files\"
strFilename = Dir(MyPath & "*.xls*", vbNormal)
Do While strFilename <> ""
Set wbSrc = Workbooks.Open(MyPath & strFilename)
'loop through each worksheet in the source file
For Each wsSrc In wbSrc.Worksheets
'Find the corresponding worksheet in the destination with the same
name as the source
For i = K To 1 Step -1
t = Sheets(i).Name
If t = "some_Accounts" Then
Application.DisplayAlerts = False
Sheets(i).Delete
Application.DisplayAlerts = True
End If
Next i
Set wsDst = wbDst.Worksheets(wsSrc.Name)
On Error GoTo 0
If wsDst.Name = wsSrc.Name Then
lLastRow = wsDst.UsedRange.Rows(wsDst.UsedRange.Rows.Count).Row + 1
wsSrc.UsedRange.Copy
wsDst.Range("A" & lLastRow).PasteSpecial xlPasteValues
End If
Next wsSrc
wbSrc.Close False
strFilename = Dir()
Loop
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Right now, you are looping through all the Worksheets in wbSrc. When wsSrc is the "some_Accounts" sheet, right after you've deleted it within For i = K to 1... End For, it no longer exists, and thus wsSrc has no Name and will throw an error later on. If you're deleting a sheet, do so before you loop through all the sheets in a workbook.
But since you are closing wbSrc without saving changes, I assume that you don't really need to delete that sheet; you can just skip it as you're looping.
That would look something like this:
For Each wsSrc In wbSrc.Worksheets
If wsSrc.Name <> "some_Accounts" Then
'... copy and pasting code here
End If
Next wsSrc
Note that you can incorporate a WorksheetExists function into your code to make sure that there is a matching sheet in wbDst. That's already been provided in another answer.
Try to put this in your code to see if the worksheet exists:
If worksheetExists(wbDst, wsDst.Name) = true then
MsgBox "Exists!"
else
MsgBox "Does not exist!"
end if
Public Function worksheetExists(ByVal wb As Workbook, ByVal sheetNameStr As String) As Boolean
On Error Resume Next
worksheetExists = (wb.Worksheets(sheetNameStr).Name <> "")
Err.Clear: On Error GoTo 0
End Function
SourceBook = ActiveWorkbook.Name
SourceSheet = Workbooks(SourceBook).Worksheets(2).Name
If Workbooks(SourceBook).Sheets(SourceSheet).Range("B10") = "SM" Then
Workbooks(SourceBook).Worksheets(SourceSheet).Range("D11:D3000,K11:K3000,N11:AC3000,CX11:CX3000,DD11:DD3000").Select
Selection.Copy
When I type code above, I am getting result.
But later, when i type code,
ElseIf Workbooks(SourceWorkbook).Sheets(SourceSheet).Range("B1") = "Status" Then
MsgBox ("okay....")
It shows "Subscript out of range (Error 9)".
Can anybody help?
You have a typo. It should be SourceBook and not SourceWorkbook
Also this is a very complicated way of doing things. Try this instead.
Sub Sample()
Dim wb As Workbook
Dim ws As Worksheet
Set wb = ActiveWorkbook '<~~ OR ThisWorkbook?
Set ws = wb.Sheets(2)
If ws.Range("B10").Value = "SM" Then
ws.Range("D11:D3000,K11:K3000,N11:AC3000,CX11:CX3000,DD11:DD3000").Copy
ElseIf ws.Range("B1").Value = "Status" Then
MsgBox ("okay....")
End If
End Sub
I have an existing worksheet "StudentSheet1" which I need to add as many times as a user needs.
For eg, if a user enters 3 in cell "A1", saves it and closes the workbook.
I want to have three sheets: "StudentSheet1" , "StudentSheet2" and "StudentSheet3" when the workbook is opened next time.
So I will have the Code in "Workbook_Open" event. I know how to insert new sheets, but cant insert this particular sheet "StudentSheet1" three times
Here is my code:
Private Sub Workbook_Open()
Application.ScreenUpdating = False
Dim ws As Worksheet
Set ws = ActiveWorkbook.Sheets.Add(Type:=xlWorksheet, After:=Worksheets(1))
Application.ScreenUpdating = True
End Sub
EDIT
Sorry I misread the question, try this:
Private Sub Workbook_Open()
Dim iLoop As Integer
Dim wbTemp As Workbook
If Not Sheet1.Range("A1").value > 0 Then Exit Sub
Application.ScreenUpdating = False
Set wbTemp = Workbooks.Open(Filename:="//Ndrive/Student/Student.xlsm")
wbTemp.Sheets("StudentSheet1").Copy After:=ThisWorkbook.Sheets(Sheets.Count)
wbTemp.Close
Set wbTemp = Nothing
With Sheet1.Range("A1")
For iLoop = 2 To .Value
Sheets("StudentSheet1").Copy After:=ThisWorkbook.Sheets(Sheets.Count)
ActiveSheet.Name = "StudentSheet" & iLoop
Next iLoop
.Value = 0
End With
Application.ScreenUpdating = True
End Sub
Why are you wanting to add sheets on the workbook open? If the user disables macros then no sheets will be added. As Tony mentioned, why not add the sheets when called by the user?
EDIT
As per #Sidd's comments, if you need to check if the sheet exists first use this function:
Function SheetExists(sName As String) As Boolean
On Error Resume Next
SheetExists = (Sheets(sName).Name = sName)
End Function
user793468, I would recommend a different approach. :)
wbTemp.Sheets("StudentSheet1").Copy After:=ThisWorkbook.Sheets(Sheets.Count)
is not reliable. Please see this link.
EDIT: The above code will fail if the workbook has defined names. Otherwise it is absolutely reliable. Thanks to Reafidy for catching that.
I just noticed OP's comment about the shared drive. Adding amended code to incorporate OP's request.
Tried and Tested
Option Explicit
Const FilePath As String = "//Ndrive/Student/Student.xlsm"
Private Sub Workbook_Open()
Dim wb1 As Workbook, wb2 As Workbook
Dim ws1 As Worksheet, ws2 As Worksheet
Dim TempName As String, NewName As String
Dim ShtNo As Long, i As Long
On Error GoTo Whoa
Application.ScreenUpdating = False
Set wb1 = ActiveWorkbook
Set ws1 = wb1.Sheets("Sheet1")
ShtNo = ws1.Range("A1")
If Not ShtNo > 0 Then Exit Sub
Set wb2 = Workbooks.Open(FilePath)
Set ws2 = wb2.Sheets("StudentSheet1")
For i = 1 To ShtNo
TempName = ActiveSheet.Name
NewName = "StudentSheet" & i
If Not SheetExists(NewName) Then
ws2.Copy After:=wb1.Sheets(Sheets.Count)
ActiveSheet.Name = NewName
End If
Next i
'~~> I leave this at your discretion.
ws1.Range("A1").ClearContents
LetsContinue:
Application.ScreenUpdating = True
On Error Resume Next
wb2.Close savechanges:=False
Set ws1 = Nothing
Set ws2 = Nothing
Set wb2 = Nothing
Set wb1 = Nothing
On Error GoTo 0
Exit Sub
Whoa:
MsgBox Err.Description
Resume LetsContinue
End Sub
'~~> Function to check if sheet exists
Function SheetExists(wst As String) As Boolean
Dim oSheet As Worksheet
On Error Resume Next
Set oSheet = Sheets(wst)
On Error GoTo 0
If Not oSheet Is Nothing Then SheetExists = True
End Function