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

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

Code:

---

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

---

Code:

---

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

---

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

Attachment 21784

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.

Quote:

---

Originally Posted by SamT

Code:

---

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

---

---

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

Code:

---

    Set rngS = FirstCellOfData.CurrentRegion

---

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

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) Attachment 21788

Code:

---

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

---

Quote:

---

Originally Posted by Paul_Hossler

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

Code:

---

    Set rngS = FirstCellOfData.CurrentRegion

---

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

---

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

Code:

---

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

---

Cheers Paul, thanks for the help.

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