Mandatory Field should required

[harinsh]

Hello,

I have typical sheet to update all mandatory fields ...the moment if I enter the A2 then entire row 2 till J2 cells should become mandatory fields. If anyone fails to update the data in the given cell then that sheet should not save the file and also should stop the excel access.

Thx

 

[fredlo2008]

Hello see if this solution helps. This code assumes that data in is a Sheet Named "Sheet1" change accordingly

Place this code in a regular module

Function Checkdata() As Boolean

Dim lrow As Long
Dim r As Range
Dim msg As String

lrow = Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row
msg = "All fields marked RED are mandatory." & vbNewLine
        msg = msg & "Please fill accordingly." & vbNewLine & vbNewLine
        msg = msg & "Nothing has been saved."
    
For Each r In Sheets("Sheet1").Range("A1:J" & lrow)
    If r.Borders.ColorIndex = 3 Then
        MsgBox msg, vbCritical + vbOKOnly, "Required Fiels"
        Checkdata = True
        Exit Function
    End If
Next
End Function

Sub BorderRed(Target As Range)

If Intersect(Target, Range("A:A")) Is Nothing Or Target.Cells.Count > 1 Then Exit Sub

With Target.Offset(0, 1).Resize(1, 9).Borders
    If Not Target.Value = vbNullString Then
        .LineStyle = xlContinuous
        .ColorIndex = 3
    Else
        .LineStyle = xlNone
    End If
End With

End Sub

Then place this code in the module of the Sheet that contains the data ( in my case Sheet1)

Private Sub Worksheet_Calculate()

Dim r As Range
Dim lrow As Long

lrow = Cells(Rows.Count, "A").End(xlUp).Row
For Each r In Range("A1:J" & lrow)
    If r.Value = vbNullString Then
        r.Borders.LineStyle = xlNone
    End If
Next
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)

Dim n As Long
    If Target.Column = 1 Then
        Call BorderRed(Target)
    End If
          
    vArray = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10)            
    For n = 1 To UBound(vArray)
        If Target.Column = vArray(n) Then
            Target.Borders.LineStyle = xlNone
        End If
    Next n

End Sub

and finally place this code under the module "ThisWorkbook"

Private Sub Workbook_BeforeClose(Cancel As Boolean)    
    If Checkdata Then Cancel = True
End Sub


Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    If Checkdata Then Cancel = True
End Sub

Thanks