Mandatory field to be validated

D

dalonglong

New Member
Joined
Jul 16, 2020
Messages
13
Office Version
  1. 2016
Platform
  1. Windows
I would like to make a vba to check all the cell below which contains the word 'mandatory' on row 6 are properly filled up.
Those that i have square in red are the potential error that this code should be giving an error message specifying which cell/cells is giving an issue (upon clicking on save button).
i am new to vba and i would like to explore how i can do that using macro. appreciate if anyone can provide some tips to go about doing this.
 

Attachments

  • mandatory field.png
    mandatory field.png
    26.2 KB · Views: 19
Sort by date Sort by votes

Excel Facts

Round to nearest half hour?
Use =MROUND(A2,"0:30") to round to nearest half hour. Use =CEILING(A2,"0:30") to round to next half hour.
Ok - in that case I suggest that the name of the sheet is written to cell A1 in sheet "Validated Result" when procedure Mandatory is run
That value will be looked up to make the "link" to the correct sheet
Do you agree? If not which cell would you prefer ?

Have you amended procedure Mandatory ?
If you have amended it please post your latest version for me
thanks
 
Upvote 0
Yongle said:
Ok - in that case I suggest that the name of the sheet is written to cell A1 in sheet "Validated Result" when procedure Mandatory is run
That value will be looked up to make the "link" to the correct sheet
Do you agree? If not which cell would you prefer ?

Have you amended procedure Mandatory ?
If you have amended it please post your latest version for me
thanks
Click to expand...


Yes A1 will be fine.

Yes I have amended the procedure and renamed it,

VBA Code: 
Sub Validation_Click()
   
    Dim ws As Worksheet, rpt As Worksheet, cel As Range
    Dim lastR As Long, lastC As Long, r As Long, c As Long
    Dim ConvertDate As String
    Dim NumInt As Integer
    Dim NumDec As Integer
    Dim PosofDecPoint As Integer
    Dim eChar As Integer
    Dim ErrCount As Integer
         
           
    Set ws = ActiveSheet
'get last column
    lastC = ws.Cells(5, ws.Columns.Count).End(xlToLeft).Column
'get last row used in any column
    For c = 2 To lastC
        lastR = WorksheetFunction.Max(lastR, ws.Cells(ws.Rows.Count, c).End(xlUp).Row)
    Next c
'insert results sheet
    Application.ScreenUpdating = False
    Set rpt = Sheets.Add
    rpt.Cells(2, 1) = "Cells"
    rpt.Cells(2, 2) = "Remarks"
   
'loop values in cells and write to results sheet

    For c = 3 To lastC
        For r = 10 To lastR
        Set cel = ws.Cells(r, c)
       
        'Check if zz field contains number
        If ws.Cells(5, c) Like "*zz*" Then
           
            For eChar = 1 To Len(cel)
                       
            If cel <> "" And IsNumeric(Mid(cel, eChar, 1)) = True Then
                rpt.Cells(rpt.Rows.Count, 1).End(xlUp).Offset(1) = cel.Address(0, 0)
                rpt.Cells(rpt.Rows.Count, 2).End(xlUp).Offset(1) = "zz field should not contain numeric numbers!"
                eChar = Len(cel)
                ErrCount = ErrCount + 1
                cel.Font.Color = RGB(255, 0, 0)

            End If
               
            Next eChar
               
        End If


        'Check if xx or yy is numeric
         If ws.Cells(5, c) Like "*xx*" Or ws.Cells(5, c) Like "*yy*" Then

            NumInt = Mid(ws.Cells(8, c), InStr(1, ws.Cells(8, c), "(", vbBinaryCompare) + 1, InStr(1, ws.Cells(8, c), ")", vbBinaryCompare) - (InStr(1, ws.Cells(8, c), "(", vbBinaryCompare) + 1))
           
                If cel <> "" And IsNumeric(cel) = False Then
                    rpt.Cells(rpt.Rows.Count, 1).End(xlUp).Offset(1) = cel.Address(0, 0)
                    rpt.Cells(rpt.Rows.Count, 2).End(xlUp).Offset(1) = "field should not contain text!"
                    ErrCount = ErrCount + 1
                    cel.Font.Color = RGB(255, 0, 0)

                End If
               
                If (Len(cel) > NumInt) Then
                    rpt.Cells(rpt.Rows.Count, 1).End(xlUp).Offset(1) = cel.Address(0, 0)
                    rpt.Cells(rpt.Rows.Count, 2).End(xlUp).Offset(1) = "Number of character exceed defined length!"
                    ErrCount = ErrCount + 1
                    cel.Font.Color = RGB(255, 0, 0)

                End If
               
        End If
   
        'Check if fields is numeric
         If ws.Cells(5, c) Like "*GG*" Then
                      
                If cel <> "" And IsNumeric(cel) = False Then
                    rpt.Cells(rpt.Rows.Count, 1).End(xlUp).Offset(1) = cel.Address(0, 0)
                    rpt.Cells(rpt.Rows.Count, 2).End(xlUp).Offset(1) = "field should not contain text!"
                    ErrCount = ErrCount + 1
                    cel.Font.Color = RGB(255, 0, 0)
                   
                End If
               
                If (Len(cel) <> 9 And cel <> "" And IsNumeric(cel) = True) Then
                    rpt.Cells(rpt.Rows.Count, 1).End(xlUp).Offset(1) = cel.Address(0, 0)
                    rpt.Cells(rpt.Rows.Count, 2).End(xlUp).Offset(1) = "GG account should be 9 digit!"
                    ErrCount = ErrCount + 1
                    cel.Font.Color = RGB(255, 0, 0)
                
                End If
               
        End If
       
        'Check for date format and validity
        If ws.Cells(8, c) Like "*Date*" Then

            ConvertDate = Mid(cel, 5, 2) & "/" & Right(cel, 2) & "/" & Left(cel, 4)
               
                If (Len(cel) = 8) Then
               
                    If (cel <> "" And IsDate(ConvertDate) = False) Or (cel <> "" And Mid(cel, 5, 2) > 12) Then
                        rpt.Cells(rpt.Rows.Count, 1).End(xlUp).Offset(1) = cel.Address(0, 0)
                        rpt.Cells(rpt.Rows.Count, 2).End(xlUp).Offset(1) = "Invalid Date, Format should be YYYYMMDD!"
                        ErrCount = ErrCount + 1
                        cel.Font.Color = RGB(255, 0, 0)
                   
                    End If
               
                End If
               
                If ((Len(cel) <> 8) And cel <> "") Then
                    rpt.Cells(rpt.Rows.Count, 1).End(xlUp).Offset(1) = cel.Address(0, 0)
                    rpt.Cells(rpt.Rows.Count, 2).End(xlUp).Offset(1) = "Invalid Date, Format should be YYYYMMDD!"
                    ErrCount = ErrCount + 1
                    cel.Font.Color = RGB(255, 0, 0)
                 
                End If

        End If
     
        'Check for Numeric fields and length
        If ws.Cells(8, c) Like "*Numeric*" Then
           
            PosofDecPoint = InStr(1, (cel), ".", vbBinaryCompare)
            NumInt = Mid(ws.Cells(8, c), InStr(1, ws.Cells(8, c), "(", vbBinaryCompare) + 1, InStr(1, ws.Cells(8, c), ",", vbBinaryCompare) - (InStr(1, ws.Cells(8, c), "(", vbBinaryCompare) + 1))
            NumDec = Mid(ws.Cells(8, c), InStr(1, ws.Cells(8, c), ",", vbBinaryCompare) + 1, InStr(1, ws.Cells(8, c), ")", vbBinaryCompare) - (InStr(1, ws.Cells(8, c), ",", vbBinaryCompare) + 1))
           
                If cel <> "" And IsNumeric(cel) = False Then
                    rpt.Cells(rpt.Rows.Count, 1).End(xlUp).Offset(1) = cel.Address(0, 0)
                    rpt.Cells(rpt.Rows.Count, 2).End(xlUp).Offset(1) = "Field should contain number only!"
                    ErrCount = ErrCount + 1
                    cel.Font.Color = RGB(255, 0, 0)

                End If
               
                If (PosofDecPoint > 0 And NumInt < PosofDecPoint - 1) Or (PosofDecPoint > 0 And NumDec < Len(cel) - PosofDecPoint) Or (PosofDecPoint = 0 And NumInt < Len(cel)) Then
                    rpt.Cells(rpt.Rows.Count, 1).End(xlUp).Offset(1) = cel.Address(0, 0)
                    rpt.Cells(rpt.Rows.Count, 2).End(xlUp).Offset(1) = "Number of character exceed defined length number!"
                    ErrCount = ErrCount + 1
                    cel.Font.Color = RGB(255, 0, 0)
                                    
                End If
               
        End If
       
  
        'Check for length of Char and Nvarchar data type
        If ws.Cells(8, c) Like "*Char*" Or ws.Cells(8, c) Like "*char*" Then

            NumInt = Mid(ws.Cells(8, c), InStr(1, ws.Cells(8, c), "(", vbBinaryCompare) + 1, InStr(1, ws.Cells(8, c), ")", vbBinaryCompare) - (InStr(1, ws.Cells(8, c), "(", vbBinaryCompare) + 1))
                                         
                If cel <> "" And Len(cel) > NumInt Then
                    rpt.Cells(rpt.Rows.Count, 1).End(xlUp).Offset(1) = cel.Address(0, 0)
                    rpt.Cells(rpt.Rows.Count, 2).End(xlUp).Offset(1) = "Number of character exceed defined length!"
                    ErrCount = ErrCount + 1
                    cel.Font.Color = RGB(255, 0, 0)
              
                End If
                       
        End If
       
       
        If ws.Cells(7, c) Like "*Mandatory*" And Len(ws.Cells(7, c)) < 50 Then

                If cel = "" Then
                    rpt.Cells(rpt.Rows.Count, 2).End(xlUp).Offset(1) = "Mandatory Cells Needs To Be Filled Up!"
                    rpt.Cells(rpt.Rows.Count, 1).End(xlUp).Offset(1) = cel.Address(0, 0)
                    ErrCount = ErrCount + 1
                    cel.Font.Color = RGB(255, 0, 0)

                End If

        End If
       
        If ErrCount = 0 Then
            cel.Font.Color = RGB(0, 0, 0)
        Else
            ErrCount = 0
        End If
           
        Next r

    Next c

End Sub
 
Upvote 0
Hi,

As an alternative idea, you could consider making the code a function to cancel save action if mandatory fields are not completed & apply data validation to highlight the cells in mandatory range that need completing.

Try updated code below & see if will do what you want

Place in STANDARD module

VBA Code: 
Function MandatoryAllComplete() As Boolean
    Dim ws As Worksheet
    Dim rng As Range
    Dim LastRow As Long, LastColumn As Long, Col As Long
    Dim CellsNotComplete As Long
    Dim m as Variant
   
    For Each ws In ThisWorkbook.Worksheets
        m = Application.Match("*Mandatory*", ws.Rows(6), 0)
        If Not IsError(m) Then ws.Activate: Exit For
    Next ws
    If IsError(m) Then Exit Function
'last column
    LastColumn = ws.Cells(7, ws.Columns.Count).End(xlToLeft).Column
'lastrow
    LastRow = ws.Cells.Find("*", Searchorder:=xlByRows, SearchDirection:=xlPrevious).Row
   
'loop each column
    For Col = 2 To LastColumn
'apply conditional formatting to all mandatory columns
        If LCase(ws.Cells(6, Col)) Like "*mandatory*" Then
            Set rng = ws.Cells(8, Col).Resize(LastRow - 7, 1)
              With rng.FormatConditions
                .Delete
                .Add(xlBlanksCondition, xlEqual, _
                "=LEN(TRIM(" & rng.Cells(1, 1).Address & "))=0").Interior.Color = vbRed
             End With
'count of all cells in mandatory ranges not completed
        CellsNotComplete = CellsNotComplete + rng.Cells.Count - Application.CountA(rng)
      
        End If
        Set rng = Nothing
    Next Col
   
    MandatoryAllComplete = CBool(CellsNotComplete = 0)
'inform user
    If Not MandatoryAllComplete Then MsgBox "Please Complete The " & CellsNotComplete & " Cell(s) Shown In Red", 48, "Entry Required"
      
End Function

Place in ThisworkBook code page

VBA Code: 
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Cancel = Not MandatoryAllComplete
End Sub

Note: it is assumed that word Mandatory will always be in row 6 of the worksheet



Just an idea, Hope Helpful



Dave
 
Upvote 0
dmt32 said:
Hi,

As an alternative idea, you could consider making the code a function to cancel save action if mandatory fields are not completed & apply data validation to highlight the cells in mandatory range that need completing.

Try updated code below & see if will do what you want

Place in STANDARD module

VBA Code: 
Function MandatoryAllComplete() As Boolean
    Dim ws As Worksheet
    Dim rng As Range
    Dim LastRow As Long, LastColumn As Long, Col As Long
    Dim CellsNotComplete As Long
    Dim m as Variant
  
    For Each ws In ThisWorkbook.Worksheets
        m = Application.Match("*Mandatory*", ws.Rows(6), 0)
        If Not IsError(m) Then ws.Activate: Exit For
    Next ws
    If IsError(m) Then Exit Function
'last column
    LastColumn = ws.Cells(7, ws.Columns.Count).End(xlToLeft).Column
'lastrow
    LastRow = ws.Cells.Find("*", Searchorder:=xlByRows, SearchDirection:=xlPrevious).Row
  
'loop each column
    For Col = 2 To LastColumn
'apply conditional formatting to all mandatory columns
        If LCase(ws.Cells(6, Col)) Like "*mandatory*" Then
            Set rng = ws.Cells(8, Col).Resize(LastRow - 7, 1)
              With rng.FormatConditions
                .Delete
                .Add(xlBlanksCondition, xlEqual, _
                "=LEN(TRIM(" & rng.Cells(1, 1).Address & "))=0").Interior.Color = vbRed
             End With
'count of all cells in mandatory ranges not completed
        CellsNotComplete = CellsNotComplete + rng.Cells.Count - Application.CountA(rng)
     
        End If
        Set rng = Nothing
    Next Col
  
    MandatoryAllComplete = CBool(CellsNotComplete = 0)
'inform user
    If Not MandatoryAllComplete Then MsgBox "Please Complete The " & CellsNotComplete & " Cell(s) Shown In Red", 48, "Entry Required"
     
End Function

Place in ThisworkBook code page

VBA Code: 
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Cancel = Not MandatoryAllComplete
End Sub

Note: it is assumed that word Mandatory will always be in row 6 of the worksheet



Just an idea, Hope Helpful



Dave
Click to expand...

Thanks! that's a suggestion i will explore into
 
Upvote 0
1. rename current result sheet "Validated Result"
2. amend Validation_Click as below
3. Run the code to prove that works
4. I will post code to link to correct cell in next post

OLD
Rich (BB code): 
'insert results sheet
    Application.ScreenUpdating = False
    Set rpt = Sheets.Add
    rpt.Cells(2, 1) = "Cells"
    rpt.Cells(2, 2) = "Remarks"

NEW
Rich (BB code): 
'CLEAR results sheet
    Application.ScreenUpdating = False
    Set rpt = Sheets("Validated Result")
    rpt.Cells.Clear
    rpt.Cells(1, 1) = ws.Name
    rpt.Cells(2, 1) = "Cells"
    rpt.Cells(2, 2) = "Remarks"
 
Upvote 0
@dalonglong
If you want to do what @dmt32 suggests then he can help you and I will leave the thread
Just let us know which way you want to go
 
Upvote 0
Yongle said:
4. I will post code to link to correct cell in next post
Click to expand...

Application.GoTo method is simpler than creating links to each cell
This is sheet code for sheet "Validated Results"
(must be placed in that SHEET's code window)
VBA Code: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    On Error Resume Next
    If Target.CountLarge > 1 Then Exit Sub
    Dim cel As Range
    Set cel = Sheets(Range("A1").Value).Range(Target.Value)
    Application.Goto Reference:=cel, scroll:=True
    On Error GoTo 0

End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

M
  • Solved
Mandatory cells based on data in other cells
Replies
1
Views
294
mumps
mumps
D
  • Solved
Providing message if red coloured cells found in specific columns
2
Replies
10
Views
972
NdNoviceHlp
NdNoviceHlp
T
  • Question Question
Making a cell mandatory to fill before being able to fill in another cell with a drop-down
Replies
3
Views
145
mumps
mumps
N
  • Solved
Find next visible cell, add a formula and then fill column down
Replies
8
Views
451
MARK858
MARK858
M
  • Question Question
How to make a number of cells mandatory if another cell is populated?
2
Replies
10
Views
2K
pjmorris
P

Forum statistics

Threads
1,224,832
Messages
6,181,231
Members
453,026
Latest member
cknader

Share this page

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