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

[darekknox]

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

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

 

[DanteAmor]

Try:

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]

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

 

[darekknox]

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]

Change Count by CountA:

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]

Thank you so much! One las think how to amend this to run on every worksheet in workbook?

 

[DanteAmor]

To all sheets:

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