Hello,
I have a code that is long and ugly, but almost finished. the Problem I have is the part highlighted below. I use variables to select start finish range. After the range is selected I'm trying to check if there are data in any cells. Unfortunately, it only checks the first "ActiveCell" in the range selected. Any help is appreciated!
Sub Staff1()
ActiveSheet.Unprotect
Application.ScreenUpdating = False
'Error Date Range Wrong
If Sheets("Staff").Range("I3").Value < 0 Then
MsgBox "*** End Date Before Start Date ***"
Range("H2").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=False, AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:=True
Exit Sub
Else
'Error Job Does Not Exist On Schedule
ActiveSheet.Unprotect
Application.ScreenUpdating = False
If Sheets("Staff").Range("D3").Value < 1 Then
MsgBox "***Job Not On Schedule***"
Range("A2").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=False, AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:=True
Exit Sub
Else
'Calendar Check - Employee name selects row
Dim ocell As Range
Dim rng As Range
Dim Lastrow As Long
Lastrow = Cells(Rows.Count, "M").End(xlUp).Row
For Each ocell In Range("M10:M10" & Lastrow)
If ocell.Value = Range("F2").Text Then
If rng Is Nothing Then
Set rng = ocell
ocell.Activate
End If
End If
If Not rng Is Nothing Then rng.Select
Set rng = Nothing
Set ocell = Nothing
Next
Range(ActiveCell.Offset(0, Range("G3").Value), ActiveCell.Offset(0, Range("H3").Value)).Select
'If No Data Exist Calendar
If ActiveCell.Value = "" Then GoTo Line1 Else GoTo Line3:
'Error If Data Exist Calendar
'If Not Selection = "" Then GoTo Line3:
'Schedule Check
Line1:
ActiveWorkbook.Worksheets("Staff").ListObjects("Jobs").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Staff").ListObjects("Jobs").Sort.SortFields.Add2 Key:=Range("Jobs[[#All],[Staff]]"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Staff").ListObjects("Jobs").Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Dim jcell As Range
Dim rng2 As Range
Dim Lastrow2 As Long
Lastrow2 = Cells(Rows.Count, "E").End(xlUp).Row
For Each jcell In Range("E10:E10" & Lastrow2)
If jcell.Value = Range("J3").Text Then
If rng Is Nothing Then
Set rng2 = jcell
jcell.Activate
End If
End If
If Not rng2 Is Nothing Then rng2.Select
Set rng2 = Nothing
Set jcell = Nothing
Next
Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(0, 4)).Select
'If No Data Exist Schedule
If ActiveCell.Value = 0 Then GoTo Line2:
'Error If Data Exist Schedule
If Not ActiveCell.Value = 0 Then GoTo Line4:
End If
Line2:
'Calendar Range Update
Lastrow = Cells(Rows.Count, "M").End(xlUp).Row
For Each ocell In Range("M10:M10" & Lastrow)
If ocell.Value = Range("F2").Text Then
If rng Is Nothing Then
Set rng = ocell
ocell.Activate
End If
End If
If Not rng Is Nothing Then rng.Select
Set rng = Nothing
Set ocell = Nothing
Next
Range(ActiveCell.Offset(0, Range("G3").Value), ActiveCell.Offset(0, Range("H3").Value)).Select
Selection = Range("J3").Value
'Schedule Range Update
Lastrow2 = Cells(Rows.Count, "E").End(xlUp).Row
For Each jcell In Range("E10:E10" & Lastrow2)
If jcell.Value = Range("J3").Text Then
If rng Is Nothing Then
Set rng2 = jcell
jcell.Activate
End If
End If
If Not rng2 Is Nothing Then rng2.Select
Set rng2 = Nothing
Set jcell = Nothing
Next
Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(0, 4)).Select
Selection = Range("F2:I2").Value
'Reset Choices
'Range("A2") = "Customer"
'Range("B2") = "Position"
'Range("F2") = "Staff Name"
'Range("G2") = "Start"
'Range("H2") = "End"
'Range("I2") = "Shift"
'Range("L10").Select
GoTo Line5:
'If Data Exist Calendar
Line3:
Selection.EntireColumn.Hidden = False
MsgBox "***Calendar Confilct***"
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=False, AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:=True
Exit Sub
'If Data Exist Schedule
Line4:
MsgBox "***Schedule Confilct***"
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=False, AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:=True
Exit Sub
Line5:
ActiveWorkbook.Worksheets("Staff").ListObjects("Jobs").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Staff").ListObjects("Jobs").Sort.SortFields.Add2 _
Key:=Range("Jobs[[#All],[Position]]"), SortOn:=xlSortOnValues, Order:= _
xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Staff").ListObjects("Jobs").Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
ActiveWorkbook.Worksheets("Staff").ListObjects("Jobs").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Staff").ListObjects("Jobs").Sort.SortFields.Add2 _
Key:=Range("Jobs[[#All],[Site]]"), SortOn:=xlSortOnValues, Order:= _
xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Staff").ListObjects("Jobs").Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=False, AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:=True
End If
End Sub
EDIT:
Sorry, this is the area I need help with,
Range(ActiveCell.Offset(0, Range("G3").Value), ActiveCell.Offset(0, Range("H3").Value)).Select
'If No Data Exist Calendar
If ActiveCell.Value = "" Then GoTo Line1 Else GoTo Line3:
I have a code that is long and ugly, but almost finished. the Problem I have is the part highlighted below. I use variables to select start finish range. After the range is selected I'm trying to check if there are data in any cells. Unfortunately, it only checks the first "ActiveCell" in the range selected. Any help is appreciated!
Sub Staff1()
ActiveSheet.Unprotect
Application.ScreenUpdating = False
'Error Date Range Wrong
If Sheets("Staff").Range("I3").Value < 0 Then
MsgBox "*** End Date Before Start Date ***"
Range("H2").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=False, AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:=True
Exit Sub
Else
'Error Job Does Not Exist On Schedule
ActiveSheet.Unprotect
Application.ScreenUpdating = False
If Sheets("Staff").Range("D3").Value < 1 Then
MsgBox "***Job Not On Schedule***"
Range("A2").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=False, AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:=True
Exit Sub
Else
'Calendar Check - Employee name selects row
Dim ocell As Range
Dim rng As Range
Dim Lastrow As Long
Lastrow = Cells(Rows.Count, "M").End(xlUp).Row
For Each ocell In Range("M10:M10" & Lastrow)
If ocell.Value = Range("F2").Text Then
If rng Is Nothing Then
Set rng = ocell
ocell.Activate
End If
End If
If Not rng Is Nothing Then rng.Select
Set rng = Nothing
Set ocell = Nothing
Next
Range(ActiveCell.Offset(0, Range("G3").Value), ActiveCell.Offset(0, Range("H3").Value)).Select
'If No Data Exist Calendar
If ActiveCell.Value = "" Then GoTo Line1 Else GoTo Line3:
'Error If Data Exist Calendar
'If Not Selection = "" Then GoTo Line3:
'Schedule Check
Line1:
ActiveWorkbook.Worksheets("Staff").ListObjects("Jobs").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Staff").ListObjects("Jobs").Sort.SortFields.Add2 Key:=Range("Jobs[[#All],[Staff]]"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Staff").ListObjects("Jobs").Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Dim jcell As Range
Dim rng2 As Range
Dim Lastrow2 As Long
Lastrow2 = Cells(Rows.Count, "E").End(xlUp).Row
For Each jcell In Range("E10:E10" & Lastrow2)
If jcell.Value = Range("J3").Text Then
If rng Is Nothing Then
Set rng2 = jcell
jcell.Activate
End If
End If
If Not rng2 Is Nothing Then rng2.Select
Set rng2 = Nothing
Set jcell = Nothing
Next
Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(0, 4)).Select
'If No Data Exist Schedule
If ActiveCell.Value = 0 Then GoTo Line2:
'Error If Data Exist Schedule
If Not ActiveCell.Value = 0 Then GoTo Line4:
End If
Line2:
'Calendar Range Update
Lastrow = Cells(Rows.Count, "M").End(xlUp).Row
For Each ocell In Range("M10:M10" & Lastrow)
If ocell.Value = Range("F2").Text Then
If rng Is Nothing Then
Set rng = ocell
ocell.Activate
End If
End If
If Not rng Is Nothing Then rng.Select
Set rng = Nothing
Set ocell = Nothing
Next
Range(ActiveCell.Offset(0, Range("G3").Value), ActiveCell.Offset(0, Range("H3").Value)).Select
Selection = Range("J3").Value
'Schedule Range Update
Lastrow2 = Cells(Rows.Count, "E").End(xlUp).Row
For Each jcell In Range("E10:E10" & Lastrow2)
If jcell.Value = Range("J3").Text Then
If rng Is Nothing Then
Set rng2 = jcell
jcell.Activate
End If
End If
If Not rng2 Is Nothing Then rng2.Select
Set rng2 = Nothing
Set jcell = Nothing
Next
Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(0, 4)).Select
Selection = Range("F2:I2").Value
'Reset Choices
'Range("A2") = "Customer"
'Range("B2") = "Position"
'Range("F2") = "Staff Name"
'Range("G2") = "Start"
'Range("H2") = "End"
'Range("I2") = "Shift"
'Range("L10").Select
GoTo Line5:
'If Data Exist Calendar
Line3:
Selection.EntireColumn.Hidden = False
MsgBox "***Calendar Confilct***"
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=False, AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:=True
Exit Sub
'If Data Exist Schedule
Line4:
MsgBox "***Schedule Confilct***"
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=False, AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:=True
Exit Sub
Line5:
ActiveWorkbook.Worksheets("Staff").ListObjects("Jobs").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Staff").ListObjects("Jobs").Sort.SortFields.Add2 _
Key:=Range("Jobs[[#All],[Position]]"), SortOn:=xlSortOnValues, Order:= _
xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Staff").ListObjects("Jobs").Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
ActiveWorkbook.Worksheets("Staff").ListObjects("Jobs").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Staff").ListObjects("Jobs").Sort.SortFields.Add2 _
Key:=Range("Jobs[[#All],[Site]]"), SortOn:=xlSortOnValues, Order:= _
xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Staff").ListObjects("Jobs").Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=False, AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:=True
End If
End Sub
EDIT:
Sorry, this is the area I need help with,
Range(ActiveCell.Offset(0, Range("G3").Value), ActiveCell.Offset(0, Range("H3").Value)).Select
'If No Data Exist Calendar
If ActiveCell.Value = "" Then GoTo Line1 Else GoTo Line3:
Last edited by a moderator: