VBA code for error on blank areas and corresponding fields

[Kabous]

Good day,

Here is another sticky problem which I’m encountering on another project which I’m working on.

What I intend to do is to have an input list where the user is required to fill in data.

This input sheet is basically divided into two sections, which ultimately form one input document with the macro button assigned.

My problem however is that I would like to indicate to the user by means of an msg box that all the fields were not completed in the first section of the input document which consist of multiple cells, rows and columns which needs to be completed. This is working fine and do exactly what I intend to do.

My problem are with the second part, which is also multiple entries in multiple cell over multiple columns, the difference however is that they are not required to fill in all the blanks but if an entry were made in cell G20, must a value be entered as well in cells J20 & M20 and also would like to display a msg box indicating that they are required to fill in these areas as well.

I have manage to write the code to do this as well, however this is copying the first section of data into my data sheet as soon as the error is received that they need to fill in a value in the other columns as well on the second part.

I cannot seem to get this to copy only the complete input sheet once everything which is required has been filled in.

Will it be possible to assist me with this and to shed some light on what I’m doing wrong here.

With this my current code in the macro which is assigned to a macro button.

Sub TRG_INPUTDATA_UPDATE()
 
On Error GoTo Err_Execute
 
    Dim historyWks As Worksheet
    Dim inputWks As Worksheet
 
    Dim nextRow As Long
    Dim oCol As Long
 
    Dim myRng As Range
    Dim myCopy As String
    Dim myCell As Range
   
    myCopy = "F6,F8,F9,F11,F12,F15" ''',F19,G21,G22,G23,G24,G25,G26,G27,G28,G29,G30,G31"
 
    Set inputWks = Worksheets("INPUT")
    Set historyWks = Worksheets("INPUTDATA ")
 
With historyWks
        nextRow = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).Row
    End With
 
    With inputWks
        Set myRng = .Range(myCopy)
 
        If Application.CountA(myRng) <> myRng.Cells.Count Then
            MsgBox "PLEASE COMPLETE ALL THE FIELDS", vbInformation, "IMPORTANT: CRITICAL"
            Exit Sub
        End If
    End With
 
    With historyWks
        With .Cells(nextRow, "A")
            .Value = Now
            .NumberFormat = "yyyy-mm-dd hh:mm:ss"
        End With
        .Cells(nextRow, "b").Value = Application.UserName
        oCol = 3
        For Each myCell In myRng.Cells
            historyWks.Cells(nextRow, oCol).Value = myCell.Value
            oCol = oCol + 1
        Next myCell
    End With
       
   ‘’This first portion is working fine     
       
 
    myCopy1 = "F19,G21,G22,G23,G24,G25,G26,G27,G28,G29,G30,G31"
   
    Set inputWks = Worksheets("TRG_INPUT")
    Set historyWks = Worksheets("TRG_INPUTDATA_A")
 
With historyWks
        nextRow = .Cells(.Rows.Count, "I").End(xlUp).Offset(1, 0).Row
    End With
 
    With inputWks
        Set myRng = .Range(myCopy1)
 
   
With inputWks
 
  If ActiveSheet.Range("G20").Value <> "" And Range("J20").Value = "" Then
                          
        MsgBox "Please provide Value LEVEL 3"
       
        Exit Sub
       
  Else
 
  If Range("G20").Value <> "" And Range("M20").Value = "" Then
  
        MsgBox "Please provide Value LEVEL 4"
       
        Exit Sub
               
  Else
 
  If Range("G21").Value <> "" And Range("J21").Value = "" Then
  
        MsgBox "Please provide Value LEVEL 3"
       
        Exit Sub
               
  Else
 
  If Range("G21").Value <> "" And Range("M21").Value = "" Then
  
        MsgBox "Please provide Value LEVEL 4"
       
        Exit Sub
                   
  Else
 
  If Range("G22").Value <> "" And Range("J22").Value = "" Then
  
        MsgBox "Please provide Value LEVEL 3"
       
        Exit Sub
                
  Else
  If Range("G22").Value <> "" And Range("M22").Value = "" Then
  
        MsgBox "Please provide Value LEVEL 4"
       
        Exit Sub
 
End If
End If
End If
End If
End If
End If
 
 
End With
 
    With historyWks
        oCol = 9
        For Each myCell In myRng.Cells
            historyWks.Cells(nextRow, oCol).Value = myCell.Value
            oCol = oCol + 1
        Next myCell
    End With
       
    myCopy2 = "I19,J21,J22,J23,J24,J25,J26,J27,J28,J29,J30,J31"
 
    Set inputWks = Worksheets("TRG_INPUT")
    Set historyWks = Worksheets("TRG_INPUTDATA_A")
 
With historyWks
        nextRow = .Cells(.Rows.Count, "I").End(xlUp).Offset(1, 0).Row
    End With
 
    With inputWks
        Set myRng = .Range(myCopy2)
 
    End With
 
    With historyWks
        oCol = 9
        For Each myCell In myRng.Cells
            historyWks.Cells(nextRow, oCol).Value = myCell.Value
            oCol = oCol + 1
        Next myCell
    End With
 
    myCopy3 = "L19,M21,M22,M23,M24,M25,M26,M27,M28,M29,M30,M31"
 
    Set inputWks = Worksheets("TRG_INPUT")
    Set historyWks = Worksheets("TRG_INPUTDATA_A")
 
With historyWks
        nextRow = .Cells(.Rows.Count, "I").End(xlUp).Offset(1, 0).Row
    End With
 
    With inputWks
        Set myRng = .Range(myCopy3)
 
    End With
 
    With historyWks
        oCol = 9
        For Each myCell In myRng.Cells
            historyWks.Cells(nextRow, oCol).Value = myCell.Value
            oCol = oCol + 1
        Next myCell
    End With
       
       
myCopy4 = "F15,F19:G19,I19:J19,L19:M19,F21:G31,I21:J31,L21:M31" 
 
    With inputWks
 
      On Error Resume Next
         With .Range(myCopy4) ''.Cells.SpecialCells(xlCellTypeConstants)
              .ClearContents
              Application.GoTo .Cells(-11) ', Scroll:=True
         End With
      On Error GoTo 0
    End With
 End With
Err_Execute:
    MsgBox "Your generated data has successfully been inserted", vbInformation, "IMPORTANT: INFO"
 
 
End Sub