VBA Error run time 1004: Application-defined or object-defined error

[plasteredric]

I'm getting an error in the following code pointing to the row in bold, any ideas how I can fix this? thanks

Sub COMPLETE_TRANSFER()


Application.Calculation = xlCalculationManual


Dim Answer As Integer
Dim rngS As Range
Dim rngD As Range
Dim Found As Range
Dim sStartSheet As String
sStartSheet = ActiveSheet.Name


Answer = MsgBox("Are you sure you want to transfer all data to Complete Sheet?", vbYesNo + vbQuestion, "Data Transfer Confirmation")


    If Answer = vbYes Then
    
                If Worksheets(sStartSheet).Range("BLANK_SHEET_CHECK").Value = "BLANK" Then
                        MsgBox "Sheet Data Blank", 0, "Validity Check Error"
                    Application.Calculation = xlCalculationAutomatic
                Exit Sub
            End If
    
                If Worksheets(sStartSheet).Range("BLANK_FORMULAS_DATA_CHECK").Value = "BLANK" Then
                        MsgBox "Sheet Formulas Blank/Incomplete", 0, "Validity Check Error"
                    Application.Calculation = xlCalculationAutomatic
                Exit Sub
            End If
    
                If Worksheets(sStartSheet).Range("BLANK_RESULTS_DATA_CHECK").Value = "BLANK" Then
                        MsgBox "Sheet Results Data Blank/Incomplete", 0, "Validity Check Error"
                    Application.Calculation = xlCalculationAutomatic
                Exit Sub
            End If
    
    Set Found = Worksheets(sStartSheet).Range("A:A").Find("***X", lookat:=xlWhole)


            If Found Is Nothing Then
                    MsgBox "Table Start Point Not Found", 0, "Check Error"
                        Application.Calculation = xlCalculationAutomatic
                Exit Sub
            End If
        
    FirstDataRow = Found.Row + 1
    HeaderDataRow = Found.Row
    FirstCellOfData = Found.Offset(1, 1)
    
    Set rngS = Worksheets(sStartSheet).Range(FirstCellOfData).CurrentRegion
    Set rngS = Intersect(rngS, rngS.Offset(1))
    Set rngD = Sheets("Complete").Range("B" & Rows.Count).End(xlUp).Offset(1)
    
    rngS.Copy
    rngD.PasteSpecial xlPasteValues
    Application.CutCopyMode = False


Else
'do nothing
        
Application.Calculation = xlCalculationAutomatic
        
End If




Application.Calculation = xlCalculationAutomatic


End Sub

[SamT]

Set FirstCellOfData = Found.Offset(1, 1)
    
Set rngS = Worksheets(sStartSheet).Range(FirstCellOfData).CurrentRegion

[plasteredric]

Thank you for the reply, unfortunately I still cant get it to work.

sample.xlsm

I've attached a stripped back sample file if you can take a look, the first macro completes by just using the cell reference which works fine, however as in the 2nd macro which finds the start of the range using 'find' keeps throwing up the same error.

Set FirstCellOfData = Found.Offset(1, 1)
    
Set rngS = Worksheets(sStartSheet).Range(FirstCellOfData).CurrentRegion

[Paul_Hossler]

Since FirstCellOfData is a Range, all you need is ...

    Set rngS = FirstCellOfData.CurrentRegion

You were treating it like it was the Name (i.e. a String) of a Range

[plasteredric]

Cheers Paul, i managed to get it working with the below code

An issue i'm having now is that if i have a blank column in the sheet the code only copies the range up to this blank column

Any ideal how i can fix this?

Thanks

(Revised sheet attached with blank column) sample.xlsm

Sub test2()
    Dim Found As Range
    Dim rngS As Range
    Dim rngD As Range
    
    Set Found = Sheets("Temp").Range("A:A").Find("***X", lookat:=xlWhole)


        If Found Is Nothing Then
            MsgBox "Table Start Point Not Found", 0, "Check Error"
            
            Exit Sub
            
        End If
        
    Set FirstCellOfData = Found.Offset(1, 1)
    
    Set rngS = FirstCellOfData.CurrentRegion
    Set rngS = Intersect(rngS, rngS.Offset(1, 1))
    Set rngD = Sheets("Complete").Range("B" & Rows.Count).End(xlUp).Offset(1)
    
    rngS.Copy
    rngD.PasteSpecial xlPasteValues
    Application.CutCopyMode = False
     
End Sub

Since FirstCellOfData is a Range, all you need is ...

    Set rngS = FirstCellOfData.CurrentRegion

You were treating it like it was the Name (i.e. a String) of a Range

[Paul_Hossler]

Try this

I like to use variable names to help me keep the logic straight in my head

Note that if you could search for "Date" you wouldn't need the 4X's marker

edit -- for some weird formatting reason, the rng X X X X variable shows as *'s

Option Explicit
Sub test2()
    Dim rngS As Range
    Dim rngD As Range
    Dim rng***X As Range
    Dim rngTopLeft As Range, rngTopRight As Range, rngBottomRight As Range
    
    
    Set rng***X = Sheets("Temp").Range("A:A").Find("***x", lookat:=xlWhole)
    If rng***X Is Nothing Then
        MsgBox "Table Start Point Not Found", 0, "Check Error"
        Exit Sub
    End If
        
    Set rngTopLeft = rng***X.Offset(0, 1)       '="Date"
    Set rngTopRight = Sheets("Temp").Cells(rngTopLeft.Row, Sheets("Temp").Columns.Count).End(xlToLeft)  '="Name"
    Set rngBottomRight = rngTopRight.End(xlDown)
        
    Set rngS = Range(rngTopLeft.Offset(1, 0), rngBottomRight)
    Set rngD = Sheets("Complete").Range("B" & Rows.Count).End(xlUp).Offset(1)
    
    rngS.Copy
    rngD.PasteSpecial xlPasteValues
    Application.CutCopyMode = False
     
End Sub

[plasteredric]

Cheers Paul, thanks for the help.

I've been playing around with what you posted and it works a charm.