Loop extracting all data but then causing runtime error 13 (Type Mismatch)

[ChrisRamsden]

Hi Everyone,

I am a brand new member, although i have been using MrExcel for tips and information for a few years now. I am currently writing an excel macro to pull data from another workbook by finding the number 4 and using offset to pick the cells i want to copy and paste.

The macro is doing it's job but it then causes a Runtime Error 13 - Type Mismatch. It feels like it is running through the loop and then causing an error when it tries to run through again. I have spent hours searching for the answer with no luck so i am calling on all you experts to help teach me something new and help me move forward with my macro:

Sub TR1797N1()
Application.ScreenUpdating = False
Dim lRow As Long
Dim cell As Object

'Change text format from single cell to multiple cells
    Windows("TR1797 N1.txt").Activate
    Columns("A:A").Select
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
        Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1 _
        )), TrailingMinusNumbers:=True
        
'Select data and copy and paste into spreadsheet. This contains a loop through the data

lRow = Range("A" & Rows.Count).End(xlUp).Row
For Each cell In Range("A1:A500")
      
    If Left(cell.Value, 1) = "4" Then
    cell.Select
    ActiveCell.Copy
    ThisWorkbook.Activate
    Sheets("TR1797").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
    Windows("TR1797 N1.txt").Activate
    ActiveCell.Offset(0, 1).Copy
    ThisWorkbook.Activate
    Sheets("TR1797").Range("B" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
    Windows("TR1797 N1.txt").Activate
    ActiveCell.Offset(0, 2).Copy
    ThisWorkbook.Activate
    Sheets("TR1797").Range("C" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
    Windows("TR1797 N1.txt").Activate
    ActiveCell.Offset(0, 4).Copy
    ThisWorkbook.Activate
    Sheets("TR1797").Range("D" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
    Windows("TR1797 N1.txt").Activate
    ActiveCell.Offset(0, 5).Copy
    ThisWorkbook.Activate
    Sheets("TR1797").Range("E" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
    Windows("TR1797 N1.txt").Activate
    ActiveCell.Offset(1, 0).Copy
    ThisWorkbook.Activate
    Sheets("TR1797").Range("F" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
    Windows("TR1797 N1.txt").Activate
    ActiveCell.Offset(6, 2).Copy
    ThisWorkbook.Activate
    Sheets("TR1797").Range("G" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
    Windows("TR1797 N1.txt").Activate
    ActiveCell.Offset(6, 3).Copy
    ThisWorkbook.Activate
    Sheets("TR1797").Range("H" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
    Windows("TR1797 N1.txt").Activate

End If
Next
End Sub

As i am new if i do anything wrong please correct me and i will remember for next time. I know there is probably a better way to do this but if i can just stop the Runtime Error it actually pulls all the information i need. The line where the error is showing is:

If Left(cell.Value, 1) = "4" Then

Thank you in advance,

Chris

 

[Nine Zero]

in line 4 where you Dim the cell try making that a Range not an Object

Dim cell As Range

 

[ChrisRamsden]

Hi Nine Zero,

I have tried this already and it still gives the same Runtime Error unfortunately.

Thank you

 

[Fluff]

What is the value in the cell when you get the error?
Is it something like #N/A

 

[ChrisRamsden]

Hi Fluff,

No the Macro is pulling the correct data and pasting it into the correct cells. Once all data sets beginning in 4 have been found, it then causes the runtime error on the line stated above. This stops the clean up section of my macro from running (which isn't posted as i tried running it as 2 subs and using the call function.

Thanks

 

[Fluff]

What if you make this change

LRow = Range("A" & Rows.Count).End(xlUp).Row
For Each Cell In Range("[COLOR=#ff0000]A1:A" & LRow[/COLOR])
      
    If Left(Cell.Value, 1) = "4" Then

 

[ChrisRamsden]

Hi Fluff,

Thanks for the suggestion, again i am still getting the runtime error and it is still pulling the information across.... its extremely frustrating.

Thank you

 

[Fluff]

How about

LRow = Range("A" & Rows.Count).End(xlUp).Row
For Each Cell In Range("A1:A500")
   If Cell <> "" Then
    If Left(Cell.Value, 1) = "4" Then
    Cell.Select
    ActiveCell.copy
    ThisWorkbook.Activate
    Sheets("TR1797").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
    Windows("TR1797 N1.txt").Activate
    ActiveCell.Offset(0, 1).copy
    ThisWorkbook.Activate
    Sheets("TR1797").Range("B" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
    Windows("TR1797 N1.txt").Activate
    ActiveCell.Offset(0, 2).copy
    ThisWorkbook.Activate
    Sheets("TR1797").Range("C" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
    Windows("TR1797 N1.txt").Activate
    ActiveCell.Offset(0, 4).copy
    ThisWorkbook.Activate
    Sheets("TR1797").Range("D" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
    Windows("TR1797 N1.txt").Activate
    ActiveCell.Offset(0, 5).copy
    ThisWorkbook.Activate
    Sheets("TR1797").Range("E" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
    Windows("TR1797 N1.txt").Activate
    ActiveCell.Offset(1, 0).copy
    ThisWorkbook.Activate
    Sheets("TR1797").Range("F" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
    Windows("TR1797 N1.txt").Activate
    ActiveCell.Offset(6, 2).copy
    ThisWorkbook.Activate
    Sheets("TR1797").Range("G" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
    Windows("TR1797 N1.txt").Activate
    ActiveCell.Offset(6, 3).copy
    ThisWorkbook.Activate
    Sheets("TR1797").Range("H" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
    Windows("TR1797 N1.txt").Activate
   End If
End If
Next

 

[ChrisRamsden]

Hi Fluff,

Tried this and the runtime error now moves onto line

If Cell <> "" Then

Again though it is still correctly pulling the data, it just won't exit the loop after the condition has been met for the final time and move on to the next statement. I even tried changing approach and using a do while loop but then it just didn't work at all.

Thank you

 

[ChrisRamsden]

Hi Everyone,

So i have found the cause of the runtime error as i single stepped through the macro and the data sheet. Within column A (after the data i am seraching for) there are 4 #NAME ? cells. Once deleted the macro runs exactly as i want it to. How can i get the macro to ignore these or delete them before searching. They likely won't be in the same cell every time so this is where is gets a little tricky.

While we are talking about this code - could i also ask if there is a way to make the code ignore the version number of the file. The TR1797N1 report also have N2, N3 and N4. Can i make the code do the same thing and ignore what number is after the N, instead of me copying the code 4 or 5 times and changing it to the alternate N number?

Thank you