Hi
Can the following line be added to the code underneath the code line - MsgBox "Cannot transfer until all data entered", vbCritical
End If

after the data has been transferred to the score sheet a Messagebox says "Data has been transferred to the Score sheet"....


Code:
Option Explicit

Dim nmFlag  As Name
    
Sub insert_data()
    
    Dim d, i As Long, k, q, x, r As Long, Rng1 As Range
    Dim c As Long, lRow As Long, Rng2 As Range, Hdr
    
    lRow = Sheets("SCORE").Range("c" & Sheets("SCORE").Rows.Count).End(3).Row
    Set Rng2 = Sheets("SCORE").Range("c3:n" & lRow)
    d = Rng2.Value2
    q = Application.Index(d, 0, 1)
    
    Set Rng1 = Sheets("WEEKLY_GRAPH").Range("B32:m37")
    Hdr = Sheets("WEEKLY_GRAPH").Range("C21:m21")
    If Application.WorksheetFunction.CountA(Rng1) = Rng1.Cells.Count Then
        k = Rng1.Value2
        
        x = Application.Match(k(1, 1), q, 0)
        If Not IsError(x) Then
            If Len(d(x, 2)) * Len(d(x, 3)) Then 'check 2 columns whether they have data in those cells
                MsgBox "It seems data already been entered for date " & CDate(k(1, 1))
                Exit Sub
            Else
                For r = 1 To UBound(k, 1)
                    For c = 1 To UBound(k, 2)
                        d(r + x - 1, c) = k(r, c)
                    Next
                Next
                For c = 2 To UBound(d, 2): d(x - 1, c) = Hdr(1, c - 1): Next
            End If
        Else
            Set Rng2 = Sheets("SCORE").Range("c3:m" & lRow + 9)
            d = Rng2.Value2
            For r = 1 To UBound(k, 1)
                For c = 1 To UBound(k, 2)
                    d(UBound(d, 1) - UBound(k, 1) + r, c) = k(r, c)
                Next
            Next
            For c = 2 To UBound(d, 2): d(UBound(d, 1) - UBound(k, 1), c) = Hdr(1, c - 1): Next
        End If
        Rng2 = d
        Rng2.Columns(1).NumberFormat = "m/d/yyyy"
        With Rng2.Resize(Rng2.Rows.Count + 2, Rng2.Columns.Count)
            .Rows.RowHeight = 25
        End With
        On Error Resume Next
        Set nmFlag = ThisWorkbook.Names("Flag")
        On Error GoTo 0
        If nmFlag Is Nothing Then
            ThisWorkbook.Names.Add "Flag", "TRUE", 1
        Else
            nmFlag.RefersTo = "TRUE"
        End If
    Else
        MsgBox "Cannot transfer until all data entered", vbCritical
    End If
    
End Sub

Sub ClearData()
    
    Dim Rng     As Range
        
    Set Rng = Sheets("WEEKLY_GRAPH").Range("c32:M36")
    On Error Resume Next
    Set nmFlag = ThisWorkbook.Names("Flag")
    On Error GoTo 0
    
    If Application.WorksheetFunction.CountA(Rng) = Rng.Cells.Count Then
        If Evaluate("Flag") Then
            Sheets("WEEKLY_GRAPH").Range("c32:M36").ClearContents
            If nmFlag Is Nothing Then
                ThisWorkbook.Names.Add "Flag", "FALSE", 1
            Else
                nmFlag.RefersTo = "FALSE"
            End If
        Else
            MsgBox "Transfer the Data first", vbInformation
        End If
    Else
        MsgBox "Cannot be deleted as incomplete", vbCritical
    End If
    
End Sub