When entering data certain cells cannot be left blank.

Sub AddRecords()
Dim Ws As Worksheet
Dim NeededCell(1 To 8) As String
Dim x
Set Ws = Worksheets("Sheet1") 'Change the sheet name as required
NeededCell(1) = Ws.Range("B6").Value
NeededCell(2) = Ws.Range("B7").Value
NeededCell(3) = Ws.Range("B21").Value
NeededCell(4) = Ws.Range("B22").Value
NeededCell(5) = Ws.Range("B36").Value
NeededCell(6) = Ws.Range("B37").Value
NeededCell(7) = Ws.Range("B51").Value
NeededCell(8) = Ws.Range("B52").Value
For x = 1 To 8
    If Len(NeededCell(x)) & vbNullString > 0 Then
        Sheets(2).Activate
        Sheets(2).Range("A1").Select 'Replace this range and Paste your macro here
    Else
        MsgBox "Your Form Is Incomplete, Please Complete The Form To Proceed"
        Ws.Range("B6").Select
        Exit Sub
    End If
Next x
End Sub

Select allOpen in new window

Option Explicit
''/// code for button
Sub AddRecord()
    Dim rCl As Range

    For Each rCl In ActiveSheet.Range("B6:B7,B21:B22,B36:B37,B51:B52")
        If IsEmpty(rCl) Then
            MsgBox "Please complete all yellow cells", vbCritical, "Input required"
            Application.EnableEvents = False
            rCl.Select
             Application.EnableEvents = True
            Exit Sub
        End If
    Next rCl
    ''///your code continues here
End Sub

Select allOpen in new window

''/// code in sheet event

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    With Target

        If .Column = 2 And .Interior.ColorIndex = 6 And IsEmpty(Target) Then
            MsgBox "This cell must be completed", vbCritical, "Input required"
        End If

    End With
End Sub

Select allOpen in new window