Hi
Try this. Assign these macro to corresponding buttons.
Code:Option Explicit Sub kTest() 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 = Sheet2.Range("c" & Sheet2.Rows.Count).End(3).Row Set Rng2 = Sheet2.Range("c3:m" & lRow) d = Rng2.Value2 q = Application.Index(d, 0, 1) Set Rng1 = Sheet1.Range("b32:l37") Hdr = Sheet1.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 = Sheet2.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 End If End Sub Sub ClearData() Sheet1.Range("b32:l36").ClearContents End Sub




Reply With Quote
Bookmarks