Only allow worksheet change if all cells in my range are empty

danbates

Active Member
Joined
Oct 8, 2017
Messages
377
Office Version
  1. 2016
Platform
  1. Windows
Hi,

Does anyone have a VBA code that stops a user from switching between worksheets in my workbook if columns A, B, E, F & G on the active row are not all blank?

Thanks

Dan
 

Excel Facts

Format cells as currency
Select range and press Ctrl+Shift+4 to format cells as currency. (Shift 4 is the $ sign).
I have managed to put this code together and it works, but only for row 485.

Code:
Private Sub Worksheet_Deactivate()  
If ThisWorkbook.Sheets("CHANGEOVER FORM").Range("A485").Value > 0 _
Or ThisWorkbook.Sheets("CHANGEOVER FORM").Range("B485").Value > 0 _
Or ThisWorkbook.Sheets("CHANGEOVER FORM").Range("E485").Value > 0 _
Or ThisWorkbook.Sheets("CHANGEOVER FORM").Range("F485").Value > 0 _
Or ThisWorkbook.Sheets("CHANGEOVER FORM").Range("G485").Value > 0 Then


MsgBox "Please either complete the last changeover or delete it"


Me.Activate


End If


End Sub

I really need some help to change the cell range from A485 to A, B485 to B and so because obviously after the next changeover this code becomes invalid.

Any help would be much appreciated.

Thanks

Dan
 
Upvote 0
Hi,

Does this get you any closer...

Code:
Private Sub Worksheet_Deactivate()


    Dim wsNew As String
    Dim ws As Worksheet: Set ws = Worksheets("CHANGEOVER FORM")
    Dim aCell As Long, i As Long
    Dim aRow As Range


    Application.ScreenUpdating = False
    wsNew = ActiveSheet.Name
    ws.Activate
    aCell = ActiveCell.Row
    Set aRow = ws.Range("A" & aCell & ":G" & aCell)
    For i = 1 To 7
        If Not aRow.Value2(1, i) = "" Then
            GoTo ComeBack
        End If
    Next
    Worksheets(wsNew).Activate
    Application.ScreenUpdating = True
    Exit Sub
ComeBack:
    MsgBox "Please either complete the last changeover or delete it"
    Worksheets("CHANGEOVER FORM").Activate
    Application.ScreenUpdating = True
    
End Sub
 
Last edited:
Upvote 0
Another option
Code:
Private Sub Worksheet_Deactivate()
   Dim i As Long
   For i = 485 To Range("A" & Rows.Count).End(xlUp).Row
      If Application.CountA(Me.Cells(i, "A").Resize(, 7)) <> 7 Then
         MsgBox "Please either complete the last changeover or delete it"
         Me.Activate
         Exit Sub
      End If
   Next i
End Sub
 
Upvote 0
Errant post. Sorry.
 
Last edited:
Upvote 0
I've done the opposite of what the OP asked for, in that it checks all rows from 485 downwards have been filled in.
Otherwise somebody could partially fill-in a number of rows & they would be allowed to leave the sheet as long as the active cell was on a blank row.
 
Upvote 0
@Fluff,

You are too quick (your response). I did not notice what the OP wrote in Post #2 at the bottom. I am kinda doing other stuff and stopping at my computer in between, so I just deleted the post, instead of sitting down and taking a second look.

Nothing good ever comes from rushing.
 
Upvote 0
Try this code
Code:
Private Sub Worksheet_Deactivate()


Application.EnableEvents = False
Dim T As Long
For T = 1 To 7
If T = 3 Then T = 5
    If Cells(ActiveCell.Row, T) = "" Then
    MsgBox ("Columns A,B,E,F,G of active row should not be blank.")
    Me.Activate
    Application.EnableEvents = True
    Exit Sub
    End If


Next T
Application.EnableEvents = True
End Sub
 
Last edited:
Upvote 0
Hi igold, Fluff & kvsrinivasamurthy

Thank you for all your replies.

After reading all your messages I have decided to use igold's code and it works just as I wanted.

Thank you again everyone for your help, it really is appreciated.

Regards

Dan
 
Upvote 0

Forum statistics

Threads
1,223,888
Messages
6,175,213
Members
452,618
Latest member
Tam84

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