VBA do not allow to save if row count does not match

darekknox

New Member
Joined
Feb 19, 2015
Messages
31
Hi,

I am looking for a code that would prevent user from saving the file if count of no empty cells in column "E" is different than in columns "F"-"AE"

Any ideas?? I tried with below but failed

Code:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)



If Application.Sheets("Sheet1").Range("E2:E").Count <> Application.Sheets("Sheet1").Range("f2:f").Count then

Cancel = True
MsgBox "Save cancelled"
End If
End Sub
 

Some videos you may like

Excel Facts

Ambidextrous Undo
Undo last command with Ctrl+Z or Alt+Backspace. If you use the Undo icon in the QAT, open the drop-down arrow to undo up to 100 steps.

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
12,594
Office Version
  1. 2007
Platform
  1. Windows
Try:

Code:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Dim u As Long, j As Long, count1 As Long, count2 As Long
    Dim rng As Range
    
    u = Sheets("Sheet1").Range("E" & Rows.Count).End(xlUp).Row
    count1 = WorksheetFunction.Count(Sheets("Sheet1").Range("E1:E" & u))
    For j = Columns("F").Column To Columns("AE").Column
        Set rng = Sheets("Sheet1").Range(Sheets("Sheet1").Cells(1, j), Sheets("Sheet1").Cells(u, j))
        count2 = WorksheetFunction.Count(rng)
        If count1 <> count2 Then
            MsgBox "Column : " & j & " is different", vbExclamation, "Save cancelled"
            Cancel = True
            Exit For
        End If
    Next


End Sub
 

darekknox

New Member
Joined
Feb 19, 2015
Messages
31
Hi,

Thank you for prompt reply, I pasted it into VBA editor but got no idea why it does not work, still allows me to save

6vXgYd3



6vXgYd3
 

darekknox

New Member
Joined
Feb 19, 2015
Messages
31
OK I got it it work with numbers, how to adjust this code to check the count of no n empty cells? I might have string fields in dat set mixed with numebrs
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
12,594
Office Version
  1. 2007
Platform
  1. Windows

ADVERTISEMENT

Change Count by CountA:

Code:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Dim u As Long, j As Long, count1 As Long, count2 As Long
    Dim rng As Range
    
    u = Sheets("Sheet1").Range("E" & Rows.Count).End(xlUp).Row
    count1 = WorksheetFunction.[COLOR=#0000ff]CountA[/COLOR](Sheets("Sheet1").Range("E1:E" & u))
    For j = Columns("F").Column To Columns("AE").Column
        Set rng = Sheets("Sheet1").Range(Sheets("Sheet1").Cells(1, j), Sheets("Sheet1").Cells(u, j))
        count2 = WorksheetFunction.[COLOR=#0000ff]CountA[/COLOR](rng)
        If count1 <> count2 Then
            MsgBox "Column : " & j & " is different", vbExclamation, "Save cancelled"
            Cancel = True
            Exit For
        End If
    Next
End Sub
 

darekknox

New Member
Joined
Feb 19, 2015
Messages
31
Thank you so much! One las think how to amend this to run on every worksheet in workbook?
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
12,594
Office Version
  1. 2007
Platform
  1. Windows
To all sheets:

Code:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Dim u As Long, j As Long, count1 As Long, count2 As Long
    Dim rng As Range
    Dim sh As Worksheet


    For Each sh In Sheets
        u = sh.Range("E" & Rows.Count).End(xlUp).Row
        count1 = WorksheetFunction.Count(sh.Range("E1:E" & u))
        For j = Columns("F").Column To Columns("AE").Column
            Set rng = sh.Range(sh.Cells(1, j), sh.Cells(u, j))
            count2 = WorksheetFunction.Count(rng)
            If count1 <> count2 Then
                MsgBox "Column : " & j & " is different, in sheet : " & sh.Name, vbExclamation, "Save cancelled"
                Cancel = True
                Exit For
            End If
        Next
    Next
End Sub
 

Watch MrExcel Video

Forum statistics

Threads
1,122,737
Messages
5,597,824
Members
414,180
Latest member
Sir Khaya

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
Top