Move Data Only After All Required Range Cells Have Been Filled

[rich_cirillo]

Hi Admin

Thanks

Can we finish this with a final alteration to the Clear Data code...can the Clear Data button only be functional once the data for that week has been entered into Records sheet...once the data has been Transferred to the Record Sheet by pressing the Transfer Data To Records button then the Data can be cleared

Thanks

Rich

[Excel Fox]

hi rich_cirillo

Thread titles should give a clear and concise objective of the thread. Please do not use words like 'Help', 'Please', etc. Users searching for objectives similar to your request will not be able to search threads with relevant keywords. You have been using online communities for quite some time now, and are expected to adhere to the general guidelines.

Thanks for co-operating. Please edit the thread, and give an appropriate thread title.

EF

[rich_cirillo]

Hi excel Fox

My apologies...I tried to edit my post but was unable to do for some reason

Thanks

Rich

[rich_cirillo]

Hi

Still need help with this request if possible

Thanks

Rich

[Admin]

Hi

try this.

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("records").Range("c" & Sheets("records").Rows.Count).End(3).Row
    Set Rng2 = Sheets("records").Range("c3:m" & lRow)
    d = Rng2.Value2
    q = Application.Index(d, 0, 1)
    
    Set Rng1 = Sheets("data").Range("b32:L37")
    Hdr = Sheets("data").Range("c21:l21")
    
    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("records").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)
            .BorderAround , xlThin
            .Borders(xlInsideHorizontal).Weight = xlThin
            .Borders(xlInsideVertical).Weight = xlThin
            .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("data").Range("c32:l37")
    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("data").Range("c32:l37").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

[rich_cirillo]

Thanks Admin

I keep getting 2 errors - 1 for insert data and the other 1 for clear data

Regards

Rich

[Admin]

Hi

Adjust your ranges. The number of columns for both the source as well as destination range should be same. The header columns will be one columns less than the source range.

[rich_cirillo]

Hi Admin
Thanks
Are you referring to the ranges within the code?
I am not sure i follow where to change.I would like to learn about code
Thanks
Rich

[Admin]

Hi

Yes, I'm talking about within the code.

Set Rng2 = Sheets("records").Range("c3:n" & lRow)

Set Rng1 = Sheets("data").Range("B32:m37")
    Hdr = Sheets("data").Range("C21:m21")

[rich_cirillo]

Hi Admin
Thank you