Runtime error 1004 when using pastespecial method

[midoop]

Hello,

I am trying to execute the following code, but I get a runtime error 1004 (pastespecial method of range class failed). I have no idea what I am doing wrong. Any help is very much appreciated because this is stressing me out.

Sub ReviewedStatusReport()
'Define variables
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim ws3 As Worksheet
Dim ws4 As Worksheet
Dim ws2row As Integer
Dim ws3row As Integer
Dim ws4row As Integer
Dim LRow As Integer
Dim LCell As String
Dim LRelocateCells As String
Application.ScreenUpdating = False
Set ws1 = ActiveSheet
ws1.Name = "CRF Review Status"
'prepare source worksheet
Range("C1") = "Visit"
Range("B1") = "Patient"
Columns("A:I").Sort key1:=Range("C2"), order1:=xlAscending, key2:=Range("B2"), order2:=xlAscending, Header:=xlYes

'Add other worksheets
Set ws2 = ActiveWorkbook.Worksheets.Add(After:=ws1)
ws2.Name = "AE Review Status"
Set ws3 = ActiveWorkbook.Worksheets.Add(After:=ws2)
ws3.Name = "ConMed Review Status"
Set ws4 = ActiveWorkbook.Worksheets.Add(After:=ws3)
ws4.Name = "ConProcedure Review Status"

ws2row = 1
ws2.Cells(ws2row, 1) = "Site"
ws2.Cells(ws2row, 2) = "Patient"
ws2.Cells(ws2row, 3) = "Visit"
ws2.Cells(ws2row, 4) = "Visit Date"
ws2.Cells(ws2row, 5) = "CRF"
ws2.Cells(ws2row, 6) = "Page Status"
ws2.Cells(ws2row, 7) = "Monitored?"
ws2.Cells(ws2row, 8) = "Reviewed?"
ws2.Cells(ws2row, 9) = "Locked?"

ws3row = 1
ws3.Cells(ws3row, 1) = "Site"
ws3.Cells(ws3row, 2) = "Patient"
ws3.Cells(ws3row, 3) = "Visit"
ws3.Cells(ws3row, 4) = "Visit Date"
ws3.Cells(ws3row, 5) = "CRF"
ws3.Cells(ws3row, 6) = "Page Status"
ws3.Cells(ws3row, 7) = "Monitored?"
ws3.Cells(ws3row, 8) = "Reviewed?"
ws3.Cells(ws3row, 9) = "Locked?"

ws4row = 1
ws4.Cells(ws4row, 1) = "Site"
ws4.Cells(ws4row, 2) = "Patient"
ws4.Cells(ws4row, 3) = "Visit"
ws4.Cells(ws4row, 4) = "Visit Date"
ws4.Cells(ws4row, 5) = "CRF"
ws4.Cells(ws4row, 6) = "Page Status"
ws4.Cells(ws4row, 7) = "Monitored?"
ws4.Cells(ws4row, 8) = "Reviewed?"
ws4.Cells(ws4row, 9) = "Locked?"

'Selecting and moving the AE data to the AE Reviewed Status sheet

ws1.Select

LRow = 2

While LRow < 10000

LCell = Range("C" & LRow).Value
LRelocateCells = "A" & LRow & ":" & "I" & LRow
Select Case LCell

Case "ADVERSE EVENTS"
Range(LRelocateCells).Cut
ws2.Select
Range(LRelocateCells).PasteSpecial

End Select

LRow = LRow + 1

Wend

End Sub

 

[wigi]

Hi

Welcome to MrExcel !

Try this largely untested improved macro procedure:

Sub ReviewedStatusReport()    
    'Define variables
    Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet, ws4 As Worksheet
    
    Application.ScreenUpdating = False
    
    Set ws1 = ActiveSheet
    With ws1
        .Name = "CRF Review Status"
        .Range("B1:C1") = [{"Patient","Visit"}]
        .Columns("A:I").Sort key1:=.Range("C2"), order1:=xlAscending, key2:=.Range("B2"), order2:=xlAscending, Header:=xlYes
    End With


    'Add other worksheets
    With ActiveWorkbook.Worksheets
        Set ws2 = .Add(After:=ws1)
        ws2.Name = "AE Review Status"
        Set ws3 = .Add(After:=ws2)
        ws3.Name = "ConMed Review Status"
        Set ws4 = .Add(After:=ws3)
        ws4.Name = "ConProcedure Review Status"
    End With
    
    With ws2.Cells(1).Resize(, 9)
        .Value = Array("Site", "Patient", "Visit", "Visit Date", "CRF", "Page Status", "Monitored?", "Reviewed?", "Locked?")
        
        Sheets(Array(.Parent.Name, ws3.Name, ws4.Name)).FillAcrossSheets .Cells
        
        'or:
        'ws3.Cells(1).Resize(, 9) = .Value
        'ws4.Cells(1).Resize(, 9) = .Value
        
    End With

    'Selecting and moving the AE data to the AE Reviewed Status sheet
    With ws1.Columns("A:I")
        .AutoFilter 3, "ADVERSE EVENTS"
        With .Offset(1).SpecialCells(xlCellTypeVisible)
            .Copy ws2.Cells(2, 1)
            .EntireRow.Delete
        End With
        .AutoFilter
    End With

End Sub

 

[wigi]

PS: Could you please use code tags when you paste VBA code on the forum?
To add code tags, type in your post:

then paste your code, and lastly, type:


['/code]


WITHOUT the single quotation mark ' in front of the /


Thanks for the consideration.

 

[Smitty]

Welcome to the Board!

You didn't specify a PasteSpecial PasteAs type.

E.G. Range(LRelocateCells).PasteSpecial xlPasteValues

HTH,

 

[midoop]

Hello y'all,
I tried both approaches and neither worked.

My goal is to select al the Adverse Event Records, move those to worksheet 2, make sure they are cleared from worksheet 1, then shift all the rows up.

I am open to other approaches.

Thanks!

 

[Smitty]

I just realized that you were Cutting not Copying, and Cutting and the PasteSpecial method don't work together.

Where did Wigi's code not work for you? That would be the smart one to go with as Filter is much more efficient than looping.

 

[midoop]

I get a Runtime error '1004' Application-defined or object-defined error and this is where the error is:

the "With .Offset(1).SpecialCells(xlCellTypeVisible)" line in the following code

 'Selecting and moving the AE data to the AE Reviewed Status sheet
    With ws1.Columns("A:I")
        .AutoFilter 3, "ADVERSE EVENTS"
        With .Offset(1).SpecialCells(xlCellTypeVisible)
            .Copy ws2.Cells(2, 1)
            .EntireRow.Delete
        End With
        .AutoFilter
    End With

 

[wigi]

Hello there

My bad, if we use an entire column (A:I), offset(1) will obviously not be possible anymore.
Correction below.

 'Selecting and moving the AE data to the AE Reviewed Status sheet
    With ws1.Columns("A:I").Resize(ws1.UsedRange.Rows.Count)
        .AutoFilter 3, "ADVERSE EVENTS"
        With .Offset(1).SpecialCells(xlCellTypeVisible)
            .Copy ws2.Cells(2, 1)
            .EntireRow.Delete
        End With
        .AutoFilter
    End With

[/QUOTE]

 

[midoop]

Thank you! That worked!
Now can you explain all of it to me, please? I have to do this for 2 other categories.
Thanks!

 

[midoop]

OH! And if you all could help me with making the columns bigger, that would be great. Thanks!