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

[rich_cirillo]

Hi

How can i make this code when opening up the workbook the first time not Clear Data unless it has been transferred.At present if i open up the workbook and i have data in range C32:M36 i can Clear this data even though i have not transferred it.It works fine after i re-enter the data as it will not let me delete until i have transferred.I just need to stop the data from being deleted when the workbook is first opened.So if i press the Clear Data commandbutton when i first open the workbook i then want it to say Transfer the Data first instead of deleting the data....this only happens when the workbook is first opened...it works fine after that

Thanks



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

[Admin]

Hi

Add this code in THISWORKBOOK module


Private Sub Workbook_Open()
ThisWorkbook.Names("Flag").RefersTo = "FALSE"
End Sub

[rich_cirillo]

Thanks Admin....works great