Sheet import macro stopped working.

Hello, I have been using this macro succesfuly for some time now and today it decided to not work. Can someone help me troubleshoot it?

It fails on this line:

Set RngEnd = SrcWks.Cells(Rows.Count, SrcRng.Column).End

Sub ImportData()

  Dim Data As Variant
  Dim DstRng As Range
  Dim DstWks As Worksheet
  Dim myFilter As String
  Dim N As Long
  Dim R As Long
  Dim RngEnd As Range
  Dim SrcRng As Range
  Dim SrcWks As Worksheet
  Dim SrcWkb As Workbook
  Dim WkbName As String
  
    Set DstWks = ThisWorkbook.Worksheets("Complaints db")
    Set DstRng = DstWks.Range("A3:U3")
    Set RngEnd = DstWks.Cells.Find("*", , xlValues, xlWhole, xlByRows, xlPrevious, False)
    
    N = IIf(RngEnd.Row < DstRng.Row, 1, RngEnd.Row - 1)
    
    myFilter = "Excel Workbooks (*.xls;*.xlsm),*.xls;*.xlsm"
    
    WkbName = Application.GetOpenFilename(myFilter)
    If WkbName = "False" Then Exit Sub
    
      Set xlApp = CreateObject("Excel.Application")
      xlApp.WindowState = xlMinimized
      Set SrcWkb = xlApp.Workbooks.Open(WkbName)
      
        UserForm1.Show
      
        Set SrcWks = SrcWkb.ActiveSheet
        
        Set SrcRng = SrcWks.Range("A3:K3")
        Set RngEnd = SrcWks.Cells(Rows.Count, SrcRng.Column).End(xlUp)
        Set SrcRng = IIf(RngEnd.Row < SrcRng.Row, SrcRng.Row, SrcWks.Range(SrcRng, RngEnd))
        
          Data = Array("G", "I", "M", "D", "O", "J", "N", "R", "Q", "A")
          
          For R = 1 To SrcRng.Rows.Count
          
            DstRng.Cells(N, Data(0)) = SrcRng.Cells(R, 1)
            DstRng.Cells(N, Data(1)) = SrcRng.Cells(R, 2)
            DstRng.Cells(N, Data(2)) = SrcRng.Cells(R, 3)
            DstRng.Cells(N, Data(3)) = SrcRng.Cells(R, 5)
            'DstRng.Cells(N, Data(4)) = SrcRng.Cells(R, 6)
            DstRng.Cells(N, Data(4)) = SrcRng.Cells(R, 7)
            DstRng.Cells(N, Data(5)) = SrcRng.Cells(R, 8)
            DstRng.Cells(N, Data(6)) = SrcRng.Cells(R, 9)
            DstRng.Cells(N, Data(7)) = SrcRng.Cells(R, 10)
            DstRng.Cells(N, Data(8)) = SrcRng.Cells(R, 11)
            DstRng.Cells(N, Data(9)) = "PIR"
            N = N + 1
          Next R
        
    SrcWkb.Close False
    xlApp.Quit
    Set xlApp = Nothing
    Columns("G:G").Select
    Selection.NumberFormat = "m/d/yyyy"
    
End Sub

I have included the workbook that contains the macro and a sample import workbook.

Here is the link to the original thread:
http://www.excelforum.com/excel-prog...readsheet.html

Thanks for any help you may be able to provide!

No sample data makes testing your macro troublesome for us, at best. Much better to simply replace sensitive data with generic entries...Name1, Name2, etc.

Your macro runs for me, but I have no data to verify it's accuracy. It doesn't stall at the point you've noted.

Maybe:

Set RngEnd = SrcWks.Cells(SrcWks.Rows.Count, SrcRng.Column).End(xlUp)

Sorry, of course it is. My bad.

The macro seems more complex than is necessary. Try this, it copies the columns of data all at once, and adds the formulas in columns U and V, too:

Option Explicit

Sub ImportData()
Dim WkbName As String
Dim SrcWkb As Workbook
Dim SrcWks As Worksheet
Dim DstWks As Worksheet
Dim DstRow As Long
Dim BtmRow As Long
Dim LstRow As Long
Application.ScreenUpdating = False

'Select data workbook
    WkbName = Application.GetOpenFilename("Excel Workbooks (*.xls;*.xlsm),*.xls;*.xlsm")
    If WkbName = "False" Then Exit Sub
    
'Set destination
    Set DstWks = ThisWorkbook.Worksheets("Complaints db")
    DstRow = DstWks.Cells.Find("*", , xlValues, xlWhole, xlByRows, xlPrevious, False).Row + 1
    
'open data workbook and select proper sheet
    Set SrcWkb = Workbooks.Open(WkbName)
    If SrcWkb.Sheets.Count > 1 Then UserForm1.Show
    Set SrcWks = SrcWkb.ActiveSheet
    
'import data (no loop)
    With SrcWks
        LstRow = .Range("A" & .Rows.Count).End(xlUp).Row
        .Range("A3:A" & LstRow).Copy
            DstWks.Range("G" & DstRow).PasteSpecial xlPasteValues
        .Range("B3:B" & LstRow).Copy
            DstWks.Range("I" & DstRow).PasteSpecial xlPasteValues
        .Range("C3:C" & LstRow).Copy
            DstWks.Range("M" & DstRow).PasteSpecial xlPasteValues
        .Range("E3:E" & LstRow).Copy
            DstWks.Range("D" & DstRow).PasteSpecial xlPasteValues
        .Range("G3:G" & LstRow).Copy
            DstWks.Range("O" & DstRow).PasteSpecial xlPasteValues
        .Range("H3:H" & LstRow).Copy
            DstWks.Range("J" & DstRow).PasteSpecial xlPasteValues
        .Range("I3:I" & LstRow).Copy
            DstWks.Range("N" & DstRow).PasteSpecial xlPasteValues
        .Range("J3:J" & LstRow).Copy
            DstWks.Range("R" & DstRow).PasteSpecial xlPasteValues
        .Range("K3:K" & LstRow).Copy
            DstWks.Range("Q" & DstRow).PasteSpecial xlPasteValues
        BtmRow = DstWks.Cells.Find("*", , xlValues, xlWhole, xlByRows, xlPrevious, False).Row
        DstWks.Range("A" & DstRow, "A" & BtmRow) = "PIR"
        DstWks.Range("U" & DstRow, "U" & BtmRow) _
            .FormulaR1C1 = "=IF(RC7="""","""",YEAR(RC7))"
        DstWks.Range("V" & DstRow, "V" & BtmRow) _
            .FormulaR1C1 = "=IF(RC7="""","""",MONTH(RC7))"
    End With

'close data workbook
    SrcWkb.Close False
    DstWks.Columns("G:G").NumberFormat = "m/d/yyyy"
    Application.ScreenUpdating = True
End Sub