Private Sub Worksheet_Change(ByVal Target As Range)

Const INSURANCE_REQUEST_MSG As String = "Contractor is not insured. Create INSURANCE Request?"
Const DBS_REQUEST_MSG As String = "Contractor has not been DBS’d. Create DBS Request?"
Const INSURANCE_DBS_REQUEST_MSG As String = "Contractor is not insured and has not been DBS’d. Create INSURANCE/DBS Request?"
Const ADMIN_REQUEST_EXISTS__MSG As String = "Contractor has already been sent an Admin Request. Create ADMIN/DBS Request?"

Dim answer As VbMsgBoxResult
Dim insured As Boolean
Dim cleared As Boolean
Dim contractor As String
Dim exists As String

'CHECK AND MAKE SURE ONLY ONE CELL IS SELECTED
If Target.CountLarge > 1 Then Exit Sub
'CHECK IF CHANGE HAPPENED IN A2
If Not Intersect(Target, Range("A2")) Is Nothing Then
Application.EnableEvents = False
ActiveSheet.Calculate 'recalculate sheet
Application.EnableEvents = True

'IF CHANGE HAPPENED IN A2 THEN SHOW RELEVANT MESSAGE DEPENDING ON THE VALUES IN G3 AND H3
CHECKS:
insured = (Range("G3").Value <> "")
cleared = (Range("H3").Value <> "")
contractor = Range("B3").Value
If Not insured And Not cleared Then
answer = MsgBox(Format(INSURANCE_DBS_REQUEST_MSG, contractor), vbYesNo + vbQuestion, "Send details")
If answer = vbYes Then
Call CopyToWorkPermit
Exit Sub
End If
ElseIf Not insured Then 'only G3 is empty
answer = MsgBox(Format(INSURANCE_REQUEST_MSG, contractor), vbYesNo + vbQuestion, "Send details")
If answer = vbYes Then
Call CopyToWorkPermit
Exit Sub
End If
ElseIf Not cleared Then 'only H3 is empty
answer = MsgBox(Format(DBS_REQUEST_MSG, contractor), vbYesNo + vbQuestion, "Send details")
If answer = vbYes Then
Call CopyToWorkPermit
Exit Sub
End If
CHECKS COMPLETE:
End If

COMPLETE:
'both G3 and H3 have values
'IF ANSWER IS YES MOVE TO THE WORK PERMIT SHEET AND EXIT THE SUB
'IF ANSWER IS NO REMAIN IN CURRENT SHEET
'IF CHANGE HAPPENED IN F2 THEN CHECK IF ALL 6 CELLS IN A2:F2 HAVE VALUES
If Not Intersect(Target, Range("F2")) Is Nothing Then
If Application.CountA(Range("A2:F2")) = 6 Then
'WHEN ALL CELLS HAVE VALUES CALL THE REQUEST SUB
Call Request
ElseIf Application.CountA(Range("A2:F2")) <> 6 Then
'SHOW PROMPT "ALL FIELDS NEED TO BE FILLED IN
MsgBox ("All fields need to be filled in")
SelectFirstEmptyCell
End If
End If
End If
End Sub

Private Sub SelectFirstEmptyCell()
Dim ws As Worksheet
Dim LastCol As Long
Set ws = ActiveSheet
Application.EnableEvents = False
LastCol = ws.Cells(2, Columns.Count).End(xlToLeft).Column
ws.Cells(2, LastCol + 1).Select
Application.EnableEvents = True
End Sub

From the routines provided above, please adjust and optimise the code to comply with the following instructions.

If change happens in A2 of Sheet Job Request, recalculate the page and check all values of Column B in the Sheeet named in I2.
If the value 'Admin request' is not present in the values of Column B in the Sheeet named in I2 then continue the routine between the label CHECKS: and CHECKS COMPLETE:
If the value 'Admin request' is present, then
Pop up a messages that asks "Admin Request has already been sent. Do you want to re-send".
If I enter yes, then continue with the rest of the routine between the label CHECKS: and CHECKS COMPLETE:
If I enetr no, do nothing until change happens in F2.
If there is change in F2 and A2:F2 <> 6 then call routine SelectFirstEmptyCell
and wait until A2:F2 <> 6.
If there is change in F2 and A2:F2 = 6 then call routine Request