VBA RunTimeError '91' - copy and pasting error

Question

Hello, I am new to this forum and was wondering if anyone could help me. I am using one workbook (1) to open a file (workbook (2)), search for a label, which is listed on a sheet in workbook (1), and copy all the data relating to that label into the sheet. However the issue that I am having is when the label does not appear in workbook (2) then I get a run-time error '91'. I have tried using "On Error Resume Next", but the wrong data gets copied into that column for the missing label. All I want is for the cells to be left blank corresponding to the missing label, and the code to continue copying all the other data correctly.

The code below looks for label name and then copies it and loops through.... Please will someone help me out! Will be very much appreciated.

Cheers

Do While 1

        'get the next variable name

        thisBookCol = ActiveCell.Address

        thisBookCol = Right(thisBookCol, Len(thisBookCol) - 1)

        thisBookCol = Left(thisBookCol, InStr(thisBookCol, "$") - 1)

        findName = Range(thisBookCol + "1")

        'Find the variable column position and copy to template

        Windows(str_fileName).Activate

        ActiveSheet.Range("B2").Select

        Selection.Copy

        Windows(thisBook).Activate

        Range("A2").Select

        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

            :=False, Transpose:=False

        Windows(str_fileName).Activate

        Columns("A:A").Select

        Selection.Find(What:="TimeStamp", After:=ActiveCell, LookIn:=xlFormulas, _

            LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _

            MatchCase:=False, SearchFormat:=False).Activate

        'On Error Resume Next

        labelnamerow = ActiveCell.Row

        Rows(labelnamerow).Select

        Selection.Find(What:=findName, After:=ActiveCell, LookIn:=xlFormulas, _

            LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _

            MatchCase:=False, SearchFormat:=False).Activate

        currPos = Right(ActiveCell.Address, Len(ActiveCell.Address) - 1) 'Remove first $

        colRef = Left(currPos, InStr(currPos, "$") - 1)

        'Range(colRef & 38).Select

        Range(colRef & (labelnamerow + 2)).Select

        Range(Selection, Selection.End(xlDown)).Select

        Selection.Copy

        Windows(thisBook).Activate

        Range(thisBookCol + "2").Select

        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

            :=False, Transpose:=False

        ActiveCell.Offset(-1, 1).Select

        'Check to see if this was the last variable required

        If thisBookCol = maxCol Then

            Exit Do

        End If

    Loop

Answer 1

We've probably forgotten some very minor point.

Download this file and take a look in it

Edit: eMail received with test files. 5/23/2014.

Alternatively, you could upload a copy of the file with any confidential/personal information obscured to one of these free file hosting sites and then post back here with the link to the file that they give you:

MediaFire: http://www.mediafire.com

Windows OneDrive: https://onedrive.live.com/

FileFactory: http://www.filefactory.com

FileSavr: http://www.filesavr.com

FileDropper: http://www.filedropper.com

RapidShare: http://www.rapidshare.com

Box.Net: http://www.box.net/files

Answer 2

Hello mate, again, thank you very much for your help. Now however the code just loops without picking up the next label. If I sent you the workbooks would you please have a look at where I am going wrong? I have spent so many hours on this, I am losing my mind…. Can I send it to you remotely?

Thanks,

Answer 3

My bad, I think - if you are getting the error here:

     If Not FoundLabel Is Nothing Then

        FoundCell.Select ' so it becomes the ActiveCell

Change FoundCell to FoundLabel

apologies...

Answer 4

Thank you very much for your quick reply. There is however a runtime error with the FoundCell.Select. I want to insert blanks into these columns.

If I remove FoundCell.Select then there is an error at ActiveCell.Offset(-1, 1).Select.

Thank you very much for your help.

Answer 5

Look at the Bold code I've added - it should help you.  When there is no match, "nothing" gets found, and that's the basic problem here.  This will help handle the no-label-found issue - although I may have the End If statements in slightly wrong place(s) - I'll leave it to you to determine what to do when there is a match and when there isn't one.

Dim FoundLabel As Range

Dim FoundCell2 As Range

Do While 1

        'get the next variable name

        thisBookCol = ActiveCell.Address

        thisBookCol = Right(thisBookCol, Len(thisBookCol) - 1)

        thisBookCol = Left(thisBookCol, InStr(thisBookCol, "$") - 1)

        findName = Range(thisBookCol + "1")

        'Find the variable column position and copy to template

        Windows(str_fileName).Activate

        ActiveSheet.Range("B2").Select

        Selection.Copy

        Windows(thisBook).Activate

        Range("A2").Select

        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

            :=False, Transpose:=False

        Windows(str_fileName).Activate

        Columns("A:A").Select

'note that I removed .Select from the end of the next statement

      Set FoundLabel  = Selection.Find(What:="TimeStamp", After:=ActiveCell, LookIn:=xlFormulas, _

LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _

MatchCase:=False, SearchFormat:=False)

         'On Error Resume Next

      If Not FoundLabel Is Nothing Then

        FoundCell.Select ' so it becomes the ActiveCell

        labelnamerow =  **** ActiveCell.Row

        Rows(labelnamerow).Select

        Set FoundCell2 = Selection.Find(What:=findName, After:=ActiveCell, LookIn:=xlFormulas, _

            LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _

            MatchCase:=False, SearchFormat:=False) ' .Activate deleted!

If Not FoundCell2 Is Nothing Then

        FoundCell.Select ' so it can become the ActiveCell for the rest of your code here

        currPos = Right(ActiveCell **** .Address, Len(ActiveCell.Address) - 1) 'Remove first $

        colRef = Left(currPos, InStr(currPos, "$") - 1)

        'Range(colRef & 38).Select

        Range(colRef & (labelnamerow + 2)).Select

        Range(Selection, Selection.End(xlDown)).Select

        Selection.Copy

        Windows(thisBook).Activate

        Range(thisBookCol + "2").Select

        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

            :=False, Transpose:=False

End If ' end test for FoundCell2 is nothing

        ActiveCell.Offset(-1, 1).Select

        End If ' end test for FoundCell is Nothing

        'Check to see if this was the last variable required

        If thisBookCol = maxCol Then

            Exit Do

        End If

    Loop