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
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
Hi excel Fox
My apologies...I tried to edit my post but was unable to do for some reason
Thanks
Rich
Hi
Still need help with this request if possible
Thanks
Rich
Hi
try this.
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("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
Thanks Admin
I keep getting 2 errors - 1 for insert data and the other 1 for clear data
Regards
Rich
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.
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
Hi
Yes, I'm talking about within the code.
Code:Set Rng2 = Sheets("records").Range("c3:n" & lRow)
Code:Set Rng1 = Sheets("data").Range("B32:m37")
Hdr = Sheets("data").Range("C21:m21")
Hi Admin
Thank you
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
Code: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
Hi
Add this code in THISWORKBOOK module
Code:Private Sub Workbook_Open()
ThisWorkbook.Names("Flag").RefersTo = "FALSE"
End Sub
Thanks Admin....works great