Error using the instruction on error goto

[jongova]

I have the following code that is causing me the error "Object Variable or With block variable not set"


The code roughly what it does is: it opens a file, search for a word, when find cut and paste a range of cells in another file.


When he returns to find and not find the word I get an error, for which we add the instruction "On Error GoTo"


But it does not work, if someone could help me thank you.


regards
jongova

Sub AbrirBuscar()
'
Dim sPath As String, sName As String
Dim bk As Workbook
On Error GoTo CerrarArchivo
sPath = "D:\Documents\SQ\Licitaciones\2013 MegaLicitacion\TEST\"
sName = Dir(sPath & "*.xls")
Do While sName <> ""
Set bk = Workbooks.Open(sPath & sName)

Cells.Find(what:="BACAL-515 (DES)", After:=ActiveCell, LookIn:= _
xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False).Activate
ActiveCell.Offset(-3, 0).Range(Cells(1, 1), Cells(62, 11)).Select
Selection.Cut
Windows("Book1").Activate
ActiveSheet.Paste
ActiveCell.Offset(62, 0).Activate
Workbooks(2).Activate


Cells.Find(what:="BACAL-515 (DES)", After:=ActiveCell, LookIn:= _
xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False).Activate
ActiveCell.Offset(-3, 0).Range(Cells(1, 1), Cells(62, 11)).Select
Selection.Cut
Windows("Book1").Activate
ActiveSheet.Paste
ActiveCell.Offset(62, 0).Activate

CerrarArchivo:
bk.Close Savechanges:=False
sName = Dir()


Loop


End Sub

 

[Andrew Poulsom]

That's because your error trap is inside your loop, and you haven't cleared the error. Here's an excellent write up on error handling:

Error Handling In VBA

 

[Norie]

It would probably be better not to rely on On Error Goto.

Instead try dealing with any errors in the code.

Perhaps with something like this.

Option Explicit

Sub AbrirBuscar()
Dim sPath As String, sName As String
Dim bk As Workbook
Dim rngFnd As Range
Dim rngSrc As Range
Dim rngDst As Range

    Set rngDst = ActiveCell

    sPath = "D:\Documents\SQ\Licitaciones\2013 MegaLicitacion\TEST\"
    sName = Dir(sPath & "*.xls")

    Do While sName <> ""

        Set bk = Workbooks.Open(sPath & sName)

        Set rngFnd = bk.ActiveSheet.Cells.Find(What:="BACAL-515 (DES)", After:=ActiveCell, LookIn:= _
                                               xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
                                               xlNext, MatchCase:=False, SearchFormat:=False)
        If Not rngFnd Is Nothing Then
            Set rngSrc = rngFnd.Offset(-3).Resize(62, 11)

            rngSrc.Copy rngDst

            Set rngDst = rngDst.Offset(62, 0)

            Set rngFnd = bk.ActiveSheet.Cells.Find(What:="BACAL-515 (DES)", After:=ActiveCell, LookIn:= _
                                                   xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
                                                   xlNext, MatchCase:=False, SearchFormat:=False)
            If Not rngFnd Is Nothing Then
                Set rngSrc = rngFnd.Offset(-3).Resize(62, 11)

                rngSrc.Copy rngDst

                Set rngDst = rngDst.Offset(62, 0)
            End If
        End If

        bk.Close Savechanges:=False
        sName = Dir()

    Loop

End Sub

 

[jongova]

Norie,

Thanks for your reply.

I was using the cut function because when the code looks for the second time, he takes the same range that already he copy.


When I wanted to change the copy function by cut function in your code I get an error.

 

[jongova]

Andrew, sorry for my ignorance, but where exactly should put the instruction "on error goto"

thanks

 

[Andrew Poulsom]

Andrew, sorry for my ignorance, but where exactly should put the instruction "on error goto"

thanks

Did you read the write-up in the link that I posted?

 

[Norie]

jongova

Did you try the code I posted without changing anything?

If it doesn't work try clearing the cells before the next Find.

 If Not rngFnd Is Nothing Then
            Set rngSrc = rngFnd.Offset(-3).Resize(62, 11)

            rngSrc.Copy rngDst

            rngSrc.Clear

            Set rngDst = rngDst.Offset(62, 0)

            Set rngFnd = bk.ActiveSheet.Cells.Find(What:="BACAL-515 (DES)", After:=ActiveCell, LookIn:= _
                                                   xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
                                                   xlNext, MatchCase:=False, SearchFormat:=False)
            If Not rngFnd Is Nothing Then
                Set rngSrc = rngFnd.Offset(-3).Resize(62, 11)

                rngSrc.Copy rngDst

                Set rngDst = rngDst.Offset(62, 0)
            End If
        End If

 

[jongova]

Clearing the cells, Now is working fine.

thanks a lot Norie.

regards
Jonathan