ActiveCell vs Active range search

esitze

New Member
Joined
Aug 24, 2018
Messages
18
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:
 
Last edited by a moderator:

Excel Facts

Repeat Last Command
Pressing F4 adds dollar signs when editing a formula. When not editing, F4 repeats last command.
You can set the range equal to a range variable, and the use the COUNTA worksheet function to count how many cells in that range have a value, i.e.
VBA Code:
    Dim rng As Range
    Set rng = Range(ActiveCell.Offset(0, Range("G3").Value), ActiveCell.Offset(0, Range("H3").Value))
    If Application.WorksheetFunction.CountA(rng) = 0 Then GoTo Line1 Else GoTo Line3:

A few other tips. Your code is very difficult to read, and will probably scare off many potential helpers. Please use the Code Tags (like I did) to maintain spacing and make your code more readable (see: How to Post Your VBA Code)

Also, I would would heavily caution against the use of a lot of GoTo statements in Excel VBA. It can result in a lot of "spaghetti code", and can make the code much harder to debug.
IMO, it should really only be reserved for error handling. I would recommend using IF/THEN or CASE statements instead to handle the different options.
 
Upvote 0
Solution
You can set the range equal to a range variable, and the use the COUNTA worksheet function to count how many cells in that range have a value, i.e.
VBA Code:
    Dim rng As Range
    Set rng = Range(ActiveCell.Offset(0, Range("G3").Value), ActiveCell.Offset(0, Range("H3").Value))
    If Application.WorksheetFunction.CountA(rng) = 0 Then GoTo Line1 Else GoTo Line3:

A few other tips. Your code is very difficult to read, and will probably scare off many potential helpers. Please use the Code Tags (like I did) to maintain spacing and make your code more readable (see: How to Post Your VBA Code)

Also, I would would heavily caution against the use of a lot of GoTo statements in Excel VBA. It can result in a lot of "spaghetti code", and can make the code much harder to debug.
IMO, it should really only be reserved for error handling. I would recommend using IF/THEN or CASE statements instead to handle the different options.
Joe4....Excellent ...Thank You, Thank You, Thank You!!!
 
Upvote 0
You are welcome.
Glad I was able to help!
 
Upvote 0

Forum statistics

Threads
1,224,815
Messages
6,181,136
Members
453,021
Latest member
Justyna P

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top