PDA

View Full Version : [SOLVED] On Error Close Worksheet



Nicolaf
08-29-2013, 04:32 AM
Hi,

I have code below:



Private Sub CommandButton1_Click()

Dim List As Worksheet
Dim BkList As Range
Dim ShtList As Range
Dim FixList As Range
Dim LastRow As Long
Dim Iname As String
Dim SName As String
Dim NewWkBk As Workbook

Dim cel As Long

Set List = ThisWorkbook.Sheets("List")
With List
LastRow = .Range("B7").End(xlDown).Row
Set BkList = .Range("B7:B" & LastRow)
Set ShtList = .Range("A7:A" & LastRow)
Set FixList = .Range("C7:C" & LastRow)
Set FixList1 = .Range("D7:D" & LastRow)
Set FixList2 = .Range("E7:E" & LastRow)

End With

For cel = 1 To BkList.Count

Iname = BkList.Cells(cel).Value 'name with extension
On Error GoTo celnext 'In case worksheet does not exist
Set NewWkBk = Workbooks.Open(Filename:="P:\Lonib\Trades\" & Iname)
SName = ShtList.Cells(cel).Value 'sheet name

Workbooks(Iname).Sheets(SName).Calculate

Workbooks(Iname).Sheets(SName).Range("M6").Copy
FixList.Cells(cel).PasteSpecial Paste:=xlPasteValues

Workbooks(Iname).Sheets(SName).Range("N6").Copy
FixList1.Cells(cel).PasteSpecial Paste:=xlPasteValues

Workbooks(Iname).Sheets(SName).Range("O6").Copy
FixList2.Cells(cel).PasteSpecial Paste:=xlPasteValues


Workbooks(Iname).Sheets(SName).Calculate
Workbooks(Iname).Saved = True

Workbooks(Iname).Close

celnext:
Next cel

End Sub


What it does is open a workbook in a specific location and then if it does not find worksheet (workbook I made sure will always exist) then On Error takes you to celnext which makes code look for another workbook and continue macro.

What I need to do is add some code so that if macro does not find worksheet, so once it reached code:



Set NewWkBk = Workbooks.Open(Filename:="P:\Lonib\Trades\" & Iname)
SName = ShtList.Cells(cel).Value 'sheet name


then it closes the workbook which it has opened (and which contains sheet not found) and only then it goes to Next cel and continues macro.
At present workbook where sheet is not found will remain open and this causes problems.

How can I do this?

:dunno:dunno

SamT
08-29-2013, 06:41 AM
How it works: Trying to use an Object that doesn't exist raises an error.
On Error GoTo line Label sends the Code Execution to the line of code after the Line Label.
If Not Object Is Nothing Then Resume Next just tries to use the Object. When it does, it continues with the next line of code.


Sub Test()
'
'
'
Set NewWkBk = Workbooks.Open(Filename:="P:\Lonib\Trades\" & IName)
Sname = ShtList.Cells(cel).Value 'sheet name
On Error GoTo BookClose
If Not NewWkBk.Sheets(Sname) Is Nothing Then Resume Next
'
'
'
Workbooks(IName).Sheets(Sname).Calculate
Workbooks(IName).Saved = True

BookClose:
NewWkBk.Close

celnext:
Set NewWkBk = Nothing
End Sub

Nicolaf
08-29-2013, 07:42 AM
Hi,

Still a few questions please.

Code in your thread should this not be as below in order to go to BookClose if worksheet not found?



On Error GoTo BookClose 'In case book does not exist
If Not NewWkBk.Sheets(SName) Is Nothing Then Resume Next
Set NewWkBk = Workbooks.Open(Filename:="P:\Lonib\Derivatives\Equity Derivatives Middle Office\Exotics\Trades\" & Iname)
SName = ShtList.Cells(cel).Value 'sheet name


Also we have



For cel = 1 To BkList.Count


So where do we put



Next cel



In final part of code below?





BookClose:
NewWkBk.Close

celnext:
Set NewWkBk = Nothing

End Sub


Thanks,
Nix

SamT
08-29-2013, 08:04 AM
Nix,

In your first question, try it both ways. Use F8 to step thru the code and watch what happens.

Next Cel goes right after CelNext

Set Object = Nothing always goes just before leaving sub. You probably don't need it in this sub.

snb
08-29-2013, 08:08 AM
Private Sub CommandButton1_Click()
on error resume next
sn= thisWorkbook.Sheets("List").cells(1).currentregion.resize(,5)

For j=7 to Ubound(sn)
with getobject("P:\Lonib\Trades\" & sn(j,2))
.sheets(sn(j,1)).activate
if err.number=0 then thisworkbook.sheets("list").cells(rows.count,3).end(xlup).offset(1).resize(,3)=.Sheets(sn(j,1)).Range ("M6:O6").value

.Close false
end with
err.clear
next
End Sub

Nicolaf
08-29-2013, 08:40 AM
Hi Sam,

I think we are nearly there, I can now manage to close workbook if the sheet does not exist.

One last question please!

Once workbook is closed the macro stops how can I make it continue?



Sub Test ()
'
'
Iname = BkList.Cells(cel).Value 'name with extension
On Error GoTo BookClose 'In case book does not exist
Set NewWkBk = Workbooks.Open(Filename:="P:\Lonib\Derivatives\Equity Derivatives Middle Office\Exotics\Trades\" & Iname)
SName = ShtList.Cells(cel).Value 'sheet name

'
'


celnext:
Next cel

BookClose:
NewWkBk.Close

End Sub



I tried




celnext:
Next cel

BookClose:
NewWkBk.Close

Resume Next

End Sub




But it did not work..

Nix

SamT
08-29-2013, 12:54 PM
I am sorry for not being more clear. The code I first posted was in a common form that only shows the new code to be added to your existing code. It was in the form
'
'
'Where comments represent your existing code that I am not showing
'
Showing one or two lines of your code so you know where to put:
Lines of code to be added
Lines of code to be added
'
'More where comments represent your existing code that I am not showing
'
'
Another one or two more lines of your code so you know where to put
Lines of code to be added
Lines of code to be added




Private Sub CommandButton1_Click()

Dim List As Worksheet
Dim BkList As Range
Dim ShtList As Range
Dim FixList As Range
Dim LastRow As Long
Dim Iname As String
Dim SName As String
Dim NewWkBk As Workbook

Dim cel As Long

Set List = ThisWorkbook.Sheets("List")
With List
LastRow = .Range("B7").End(xlDown).Row
Set BkList = .Range("B7:B" & LastRow)
Set ShtList = .Range("A7:A" & LastRow)
Set FixList = .Range("C7:C" & LastRow)
Set FixList1 = .Range("D7:D" & LastRow)
Set FixList2 = .Range("E7:E" & LastRow)

End With

For cel = 1 To BkList.Count

Iname = BkList.Cells(cel).Value 'name with extension
On Error GoTo celnext 'In case worksheet does not exist
Set NewWkBk = Workbooks.Open(Filename:="P:\Lonib\Trades\" & Iname)
SName = ShtList.Cells(cel).Value 'sheet name
On Error GoTo BookClose
If Not NewWkBk.Sheets(SName) Is Nothing Then Resume Next

Workbooks(Iname).Sheets(SName).Calculate

Workbooks(Iname).Sheets(SName).Range("M6").Copy
FixList.Cells(cel).PasteSpecial Paste:=xlPasteValues

Workbooks(Iname).Sheets(SName).Range("N6").Copy
FixList1.Cells(cel).PasteSpecial Paste:=xlPasteValues

Workbooks(Iname).Sheets(SName).Range("O6").Copy
FixList2.Cells(cel).PasteSpecial Paste:=xlPasteValues


Workbooks(Iname).Sheets(SName).Calculate
Workbooks(Iname).Saved = True

BookClose:
NewWkBk.Close

celnext:
Next cel
End Sub