CSV Import Edit then Paste

[RAYLWARD102]

I have some code that I have mixed together. It works great except for if the user delete's some rows. I'll quickly explain the normal chain of events.

The user exports data from another program in a file format (CSV) but the program gives the file an extension of .tab.

The macro imports a2:dv300 from the tab file into a sheet named dump2
another macro inserts a blank row after every line of data until there is no data.
Then the macro pastes sheet (dump2) range a1:dv300 to another sheet called dump.

My macro does all of this perfectly.
A problem can arrive when the user imports the csv data; and delete's some rows. When they delete a couple of rows from the imported data; I get a runtime error when trying to run the code that inserts the blank row after every line of data.

Here is the copy paste from csv to sheet dump2 code

Private Sub CommandButton1_Click()
 Dim folder As String
    Dim Wb As Workbook, sFile As String
    Dim Cwb As Workbook
    Dim lrow As Long
    folder = ThisWorkbook.Path & "\"
     '    folder = "C:\Temp\"
    Set Cwb = ThisWorkbook
    sFile = Dir(folder & "*.tab")
    Do While sFile <> ""
        If sFile <> Cwb.Name Then
             'If there are sheets without a data sheet
             'continue with code to import
             'the rest that has a sheet with the name data
            On Error Resume Next
            Set Wb = Workbooks.Open(folder & sFile)
            lrow = Cwb.Worksheets("Data").Range("A" & Rows.Count).End(xlUp).Row
            'lrow = lrow + 1
            'Wb.Worksheets("sold").Range("A17:J33").Copy
            Wb.Worksheets("sold").Range("a2:dv300").Copy
            Cwb.Worksheets("DUMP2").Range("A" & lrow + 1).PasteSpecial xlPasteValues
            Application.CutCopyMode = False
            Wb.Close True
        End If
        sFile = Dir
    Loop
    Cwb.Worksheets("DUMP2").Range("A1").Select
End Sub

Here is the code used to add 1 empty row of data until the end of the data....and then paste the findings to a sheet named dump

Private Sub CommandButton2_Click()
 Selection.End(xlDown).Select
 
    Do Until ActiveCell.Row = 1
        ' Copy to every other row
        Rows(ActiveCell.Row * 2 - 1).Value = ActiveCell.EntireRow.Value
        ActiveCell.EntireRow.Clear
        'Move up one row.
        ActiveCell.Offset(-1, 0).Select
    Loop
Workbooks("manifest&invoice.xls").Activate
Sheets("dump2").Range("a1:dw300").Copy Workbooks("manifest&invoice.xls").Sheets("dump").Range("A1:dv300")
Application.CutCopyMode = False
Application.DisplayAlerts = True
Application.ScreenUpdating = True
With Sheets("MANIFEST")
    .PageSetup.PrintArea = "$A$1:$L$" & .Range("o24").Value
End With
Sheets("manifest").PrintOut Copies:=1, Collate:=True
With Sheets("INVOICE")
    .PageSetup.PrintArea = "$A$1:$M$" & .Range("r13").Value
End With
Sheets("invoice").PrintOut Copies:=1, Collate:=True
Sheets("DUMP").Range("A1:DW300").ClearContents
Sheets("DUMP2").Range("A1:DW300").ClearContents
Worksheets("DUMP2").Range("A1").Select
End Sub

When the runtime error occurs it stops me at the line:
Rows(ActiveCell.Row * 2 - 1).Value = ActiveCell.EntireRow.Value
error: runtime 1004; application-defined or object-defiend error
IT also looks like it trys to start at row number 65536 when I only have maybe 20 rows of data.

 

[AlphaFrog]

Replace this...

 Selection.End(xlDown).Select

    Do Until ActiveCell.Row = 1
        ' Copy to every other row
        Rows(ActiveCell.Row * 2 - 1).Value = ActiveCell.EntireRow.Value
        ActiveCell.EntireRow.Clear
        'Move up one row.
        ActiveCell.Offset(-1, 0).Select
    Loop

With this...

    Dim r As Long, lastrow As Long
    
    With Sheets("dump2")
    
        Application.ScreenUpdating = False
        
        lastrow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        
        For r = lastrow To 2 Step -1
            ' Copy to every other row
            .Rows(r * 2 - 1).Value = .Rows(r).Value
            .Rows(r).Clear
        Next r
        
        Application.ScreenUpdating = True
        
    End With

 

[RAYLWARD102]

Awesome! That worked. Do you have a simple reason as to whyt the other way didn't work....Just trying to learn.

 

[AlphaFrog]

This...
Selection.End(xlDown).Select
...finds the last used cell below the current Selection. If the current selection is already below the last used cell (e.g. they deleted the bottom rows), then it finds the last row on the sheet (Row number 65536) and selects it.

Then this line...
Rows(ActiveCell.Row * 2 - 1).Value = ActiveCell.EntireRow.Value
...tries to paste the ActeveRow down to 2x the Active row. If the Active Row is already the last row on the sheet, that causes the error. You cant reference a row below the last row on the sheet.

The new code doesn't use the current Selection to find the last used row.