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
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