Range Occupied Pop Up

[niha]

Hi Guys!
I really need your help on this one! This is the last step of my project, and I'm not able to figure out how to do this. So some values are entered in column D and E. D is the "from location" and E is the "to location", which depicts that everything between these 2 locations (in this case 10-45, including them) is occupied. This is unique for every row. So whenever a user enters a value in A3 in between 10-45, eg 12,30,40 (including them), an error message should pop up - saying this location is occupied.
Total locations are from 1-350
Also, one more condition here is that this message should occur if the cell in the same row under the progress column is empty. If its filled with "In Progress" the message shouldn't pop up.

 

[Alex Blakenburg]

Try this

Private Sub Worksheet_Change(ByVal Target As Range)
    
    Application.EnableEvents = False
    Const FirstRow As Long = 6
    Const FromCol As Long = 4
    Const ToCol As Long = 5
    Const ProgressCol As Long = 8
    
    Dim result As Variant
    Dim LastRow As Long
    Dim sh As Worksheet
    Dim RowNo As Long
    
    If Not Intersect(Target, Range("A3")) Is Nothing Then
        On Error GoTo MyErrorHandler
        Set sh = ActiveSheet
        LastRow = sh.Cells(sh.Rows.Count, FromCol).End(xlUp).Row
        
        For RowNo = FirstRow To LastRow
            If sh.Cells(RowNo, FromCol) <= Range("A3") And _
                sh.Cells(RowNo, ToCol) >= Range("A3") And _
                InStr(1, sh.Cells(RowNo, ProgressCol), "In Progress", vbTextCompare) = 0 Then
                    MsgBox Prompt:="This location is occupied", Title:="Location Entry Check"
                    Exit For
            End If
        
        Next RowNo

    End If
    
CleanExit:
    Range("A3").Select
    Application.EnableEvents = True
    Exit Sub
    
MyErrorHandler:
    GoTo CleanExit

End Sub

 

[niha]

T

Try this

Private Sub Worksheet_Change(ByVal Target As Range)
   
    Application.EnableEvents = False
    Const FirstRow As Long = 6
    Const FromCol As Long = 4
    Const ToCol As Long = 5
    Const ProgressCol As Long = 8
   
    Dim result As Variant
    Dim LastRow As Long
    Dim sh As Worksheet
    Dim RowNo As Long
   
    If Not Intersect(Target, Range("A3")) Is Nothing Then
        On Error GoTo MyErrorHandler
        Set sh = ActiveSheet
        LastRow = sh.Cells(sh.Rows.Count, FromCol).End(xlUp).Row
       
        For RowNo = FirstRow To LastRow
            If sh.Cells(RowNo, FromCol) <= Range("A3") And _
                sh.Cells(RowNo, ToCol) >= Range("A3") And _
                InStr(1, sh.Cells(RowNo, ProgressCol), "In Progress", vbTextCompare) = 0 Then
                    MsgBox Prompt:="This location is occupied", Title:="Location Entry Check"
                    Exit For
            End If
       
        Next RowNo

    End If
   
CleanExit:
    Range("A3").Select
    Application.EnableEvents = True
    Exit Sub
   
MyErrorHandler:
    GoTo CleanExit

End Sub
[/CO
[/QUOTE]

 

[niha]

Try this

Private Sub Worksheet_Change(ByVal Target As Range)
   
    Application.EnableEvents = False
    Const FirstRow As Long = 6
    Const FromCol As Long = 4
    Const ToCol As Long = 5
    Const ProgressCol As Long = 8
   
    Dim result As Variant
    Dim LastRow As Long
    Dim sh As Worksheet
    Dim RowNo As Long
   
    If Not Intersect(Target, Range("A3")) Is Nothing Then
        On Error GoTo MyErrorHandler
        Set sh = ActiveSheet
        LastRow = sh.Cells(sh.Rows.Count, FromCol).End(xlUp).Row
       
        For RowNo = FirstRow To LastRow
            If sh.Cells(RowNo, FromCol) <= Range("A3") And _
                sh.Cells(RowNo, ToCol) >= Range("A3") And _
                InStr(1, sh.Cells(RowNo, ProgressCol), "In Progress", vbTextCompare) = 0 Then
                    MsgBox Prompt:="This location is occupied", Title:="Location Entry Check"
                    Exit For
            End If
       
        Next RowNo

    End If
   
CleanExit:
    Range("A3").Select
    Application.EnableEvents = True
    Exit Sub
   
MyErrorHandler:
    GoTo CleanExit

End Sub

Thankyou so much Alex! This works

 

[Alex Blakenburg]

No problem, glad it worked for you.