Lukums
07-25-2016, 09:57 PM
hey guys... new here and not sure how to go about this one.
It's been playing on me for the last 2 hours and I've hit that wall...
Run-Time error '-2147417848(80010108)
Method 'Range' of object'_Worksheet' failed
I can step through this F8 and works like a charm.
I can't work out why it's stopping on this line... when using a macro button within excel.
LastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
Here is my code below if it helps...
''''''''''''''''''''''''''''''''''''''''
Sub CSectionDevelopment()
Sheets("Development").Select
LastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
For i = 3 To LastRow
'P3 = CLEAR JOB PUSH
'BR3 = LOAD NEW JOB
'BT3 = START
'Q3 = JOB COMPLETED
'BU3 = FLAG JOB COMPLETED 2
'BS3 = GRANTS MAGIC
If ActiveSheet.Range("A4").Value = "Job Completed" And Range("B4").Value = "1" And Range("C4").Value <> "1" And Range("D4").Value = "2" And Range("E4").Value = "1" And Range("F4").Value = "2" Then
'FLAGS COMPLETED JOB WITH UNIQUE VALUE TO MOVE
Range("D4").Select
ActiveCell.FormulaR1C1 = "0"
Rows("4:4").Select
Selection.Copy
Sheets("Development").Select
erow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
ActiveSheet.Cells(erow, 1).Select
ActiveSheet.Paste
Application.CutCopyMode = False
'Next JOB Load UP
Rows("5:5").Select
Application.CutCopyMode = False
Selection.Copy
Rows("4:4").Select
ActiveSheet.Paste
'dELETE ROW 5 AND SHIFT UP
Rows("5:5").Select
Selection.Delete Shift:=xlUp
' WONT RUN AGAIN UNTIL GRANT GIVES ME 1 IN GRANTS MAGIC
Range("D4").Select
ActiveCell.FormulaR1C1 = "1"
'''''
'QTY WRITE TO 0 - PLC PARAMETER - CLEARING ALL VALUES WITHHELD
Range("C4").Select
ActiveCell.FormulaR1C1 = "1"
'Application.Wait (Now + TimeValue("0:00:01"))
'ADD LINE POSITION BACK
Range("F3").Select
ActiveCell.FormulaR1C1 = "1"
Range("F4").Select
ActiveCell.FormulaR1C1 = "2"
Range("F5").Select
ActiveCell.FormulaR1C1 = "3"
Range("F6").Select
ActiveCell.FormulaR1C1 = "4"
Range("F7").Select
ActiveCell.FormulaR1C1 = "5"
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''
'''
'''
'Ridge 400 Machine' formuals
End If
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''
'''
If Range("G4").Value = "1" Then
Range("C4").Select
ActiveCell.FormulaR1C1 = "0"
Range("D4").Select
ActiveCell.FormulaR1C1 = "0"
End If
'''
'''
'If Range("A2").Value = "Job Completed" Then
'Call CSectionDevelopment2
'Exit Sub
'End If
Next i
Call CSectionDevelopment2
End Sub
Sub CSectionDevelopment2()
Sheets("Development").Select
LastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
For i = 3 To LastRow
'P3 = CLEAR JOB PUSH
'BR3 = LOAD NEW JOB
'BT3 = START
'Q3 = JOB COMPLETED
'BU3 = FLAG JOB COMPLETED 2
'BS3 = GRANTS MAGIC
If ActiveSheet.Range("A3").Value = "Job Completed" And Range("B3").Value = "1" And Range("C3").Value <> "1" And Range("D3").Value = "2" And Range("E3").Value = "1" And Range("F3").Value = "1" Then
'FLAGS COMPLETED JOB WITH UNIQUE VALUE TO MOVE
Range("D3").Select
ActiveCell.FormulaR1C1 = "0"
Rows("3:3").Select
Selection.Copy
erow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
ActiveSheet.Cells(erow, 1).Select
ActiveSheet.Paste
Application.CutCopyMode = False
'Next JOB Load UP
Rows("5:5").Select
Application.CutCopyMode = False
Selection.Copy
Rows("3:3").Select
ActiveSheet.Paste
'dELETE ROW 5 AND SHIFT UP
Rows("5:5").Select
Selection.Delete Shift:=xlUp
' WONT RUN AGAIN UNTIL GRANT GIVES ME 1 IN GRANTS MAGIC
Range("D3").Select
ActiveCell.FormulaR1C1 = "1"
'''''
'QTY WRITE TO 0 - PLC PARAMETER - CLEARING ALL VALUES WITHHELD
Range("C3").Select
ActiveCell.FormulaR1C1 = "1"
'Application.Wait (Now + TimeValue("0:00:01"))
'ADD LINE POSITION BACK
Range("F3").Select
ActiveCell.FormulaR1C1 = "1"
Range("F4").Select
ActiveCell.FormulaR1C1 = "2"
Range("F5").Select
ActiveCell.FormulaR1C1 = "3"
Range("F6").Select
ActiveCell.FormulaR1C1 = "4"
Range("F7").Select
ActiveCell.FormulaR1C1 = "5"
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''
'''
'''
'Ridge 400 Machine' formuals
End If
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''
'''
If Range("G3").Value = "1" Then
Range("C3").Select
ActiveCell.FormulaR1C1 = "0"
Range("D3").Select
ActiveCell.FormulaR1C1 = "0"
End If
'''
'''
'If Range("A2").Value = "Job Completed" Then
'Exit Sub
'End If
Next i
Call CSectionDevelopmentSave
End Sub
Sub CSectionDevelopmentSave()
LastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
For i = 3 To LastRow
If Range("A" & i).Value = "Job Completed" And Range("E" & i).Value = "1" Then
Rows(i).Select
Selection.Copy
Workbooks.Open Filename:="C:\Users\luke\Desktop\BEST SHED SHCEDULER\RecordedDailyJobs.xlsm"
Dim p As Integer, q As Integer
p = Worksheets.Count
For q = 1 To p
Next q
Sheets("Sheet1").Select
erow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
ActiveSheet.Cells(erow, 1).Select
ActiveSheet.Paste
ActiveWorkbook.Save
ActiveWorkbook.Close
Application.CutCopyMode = False
End If
If Range("A" & i).Value = "Job Completed" And Range("E" & i).Value = "1" Then
Rows(i).Select
Selection.ClearContents
End If
Next i
Call CSectionDevelopment
End Sub
It's been playing on me for the last 2 hours and I've hit that wall...
Run-Time error '-2147417848(80010108)
Method 'Range' of object'_Worksheet' failed
I can step through this F8 and works like a charm.
I can't work out why it's stopping on this line... when using a macro button within excel.
LastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
Here is my code below if it helps...
''''''''''''''''''''''''''''''''''''''''
Sub CSectionDevelopment()
Sheets("Development").Select
LastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
For i = 3 To LastRow
'P3 = CLEAR JOB PUSH
'BR3 = LOAD NEW JOB
'BT3 = START
'Q3 = JOB COMPLETED
'BU3 = FLAG JOB COMPLETED 2
'BS3 = GRANTS MAGIC
If ActiveSheet.Range("A4").Value = "Job Completed" And Range("B4").Value = "1" And Range("C4").Value <> "1" And Range("D4").Value = "2" And Range("E4").Value = "1" And Range("F4").Value = "2" Then
'FLAGS COMPLETED JOB WITH UNIQUE VALUE TO MOVE
Range("D4").Select
ActiveCell.FormulaR1C1 = "0"
Rows("4:4").Select
Selection.Copy
Sheets("Development").Select
erow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
ActiveSheet.Cells(erow, 1).Select
ActiveSheet.Paste
Application.CutCopyMode = False
'Next JOB Load UP
Rows("5:5").Select
Application.CutCopyMode = False
Selection.Copy
Rows("4:4").Select
ActiveSheet.Paste
'dELETE ROW 5 AND SHIFT UP
Rows("5:5").Select
Selection.Delete Shift:=xlUp
' WONT RUN AGAIN UNTIL GRANT GIVES ME 1 IN GRANTS MAGIC
Range("D4").Select
ActiveCell.FormulaR1C1 = "1"
'''''
'QTY WRITE TO 0 - PLC PARAMETER - CLEARING ALL VALUES WITHHELD
Range("C4").Select
ActiveCell.FormulaR1C1 = "1"
'Application.Wait (Now + TimeValue("0:00:01"))
'ADD LINE POSITION BACK
Range("F3").Select
ActiveCell.FormulaR1C1 = "1"
Range("F4").Select
ActiveCell.FormulaR1C1 = "2"
Range("F5").Select
ActiveCell.FormulaR1C1 = "3"
Range("F6").Select
ActiveCell.FormulaR1C1 = "4"
Range("F7").Select
ActiveCell.FormulaR1C1 = "5"
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''
'''
'''
'Ridge 400 Machine' formuals
End If
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''
'''
If Range("G4").Value = "1" Then
Range("C4").Select
ActiveCell.FormulaR1C1 = "0"
Range("D4").Select
ActiveCell.FormulaR1C1 = "0"
End If
'''
'''
'If Range("A2").Value = "Job Completed" Then
'Call CSectionDevelopment2
'Exit Sub
'End If
Next i
Call CSectionDevelopment2
End Sub
Sub CSectionDevelopment2()
Sheets("Development").Select
LastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
For i = 3 To LastRow
'P3 = CLEAR JOB PUSH
'BR3 = LOAD NEW JOB
'BT3 = START
'Q3 = JOB COMPLETED
'BU3 = FLAG JOB COMPLETED 2
'BS3 = GRANTS MAGIC
If ActiveSheet.Range("A3").Value = "Job Completed" And Range("B3").Value = "1" And Range("C3").Value <> "1" And Range("D3").Value = "2" And Range("E3").Value = "1" And Range("F3").Value = "1" Then
'FLAGS COMPLETED JOB WITH UNIQUE VALUE TO MOVE
Range("D3").Select
ActiveCell.FormulaR1C1 = "0"
Rows("3:3").Select
Selection.Copy
erow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
ActiveSheet.Cells(erow, 1).Select
ActiveSheet.Paste
Application.CutCopyMode = False
'Next JOB Load UP
Rows("5:5").Select
Application.CutCopyMode = False
Selection.Copy
Rows("3:3").Select
ActiveSheet.Paste
'dELETE ROW 5 AND SHIFT UP
Rows("5:5").Select
Selection.Delete Shift:=xlUp
' WONT RUN AGAIN UNTIL GRANT GIVES ME 1 IN GRANTS MAGIC
Range("D3").Select
ActiveCell.FormulaR1C1 = "1"
'''''
'QTY WRITE TO 0 - PLC PARAMETER - CLEARING ALL VALUES WITHHELD
Range("C3").Select
ActiveCell.FormulaR1C1 = "1"
'Application.Wait (Now + TimeValue("0:00:01"))
'ADD LINE POSITION BACK
Range("F3").Select
ActiveCell.FormulaR1C1 = "1"
Range("F4").Select
ActiveCell.FormulaR1C1 = "2"
Range("F5").Select
ActiveCell.FormulaR1C1 = "3"
Range("F6").Select
ActiveCell.FormulaR1C1 = "4"
Range("F7").Select
ActiveCell.FormulaR1C1 = "5"
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''
'''
'''
'Ridge 400 Machine' formuals
End If
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''
'''
If Range("G3").Value = "1" Then
Range("C3").Select
ActiveCell.FormulaR1C1 = "0"
Range("D3").Select
ActiveCell.FormulaR1C1 = "0"
End If
'''
'''
'If Range("A2").Value = "Job Completed" Then
'Exit Sub
'End If
Next i
Call CSectionDevelopmentSave
End Sub
Sub CSectionDevelopmentSave()
LastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
For i = 3 To LastRow
If Range("A" & i).Value = "Job Completed" And Range("E" & i).Value = "1" Then
Rows(i).Select
Selection.Copy
Workbooks.Open Filename:="C:\Users\luke\Desktop\BEST SHED SHCEDULER\RecordedDailyJobs.xlsm"
Dim p As Integer, q As Integer
p = Worksheets.Count
For q = 1 To p
Next q
Sheets("Sheet1").Select
erow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
ActiveSheet.Cells(erow, 1).Select
ActiveSheet.Paste
ActiveWorkbook.Save
ActiveWorkbook.Close
Application.CutCopyMode = False
End If
If Range("A" & i).Value = "Job Completed" And Range("E" & i).Value = "1" Then
Rows(i).Select
Selection.ClearContents
End If
Next i
Call CSectionDevelopment
End Sub