PDA

View Full Version : [SOLVED] VBA Error run time 1004: Application-defined or object-defined error



plasteredric
03-08-2018, 09:59 AM
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
03-08-2018, 10:43 AM
Set FirstCellOfData = Found.Offset(1, 1)

Set rngS = Worksheets(sStartSheet).Range(FirstCellOfData).CurrentRegion

plasteredric
03-09-2018, 05:00 AM
Thank you for the reply, unfortunately I still cant get it to work.

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.




Set FirstCellOfData = Found.Offset(1, 1)

Set rngS = Worksheets(sStartSheet).Range(FirstCellOfData).CurrentRegion

Paul_Hossler
03-09-2018, 06:54 AM
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
03-09-2018, 05:03 PM
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) 21788



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
03-09-2018, 06:50 PM
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
03-18-2018, 07:40 AM
Cheers Paul, thanks for the help.

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