Archiving Data

[erutherford]

If I make this simple code work I can modify to fit my needs. I archive data once a year. So col.A contains the current year. Just want check to see if the current year has been copied over to "shWrite". If it has msgbox says "already done". If not, go a head and paste. Then 2023 come around and it looks for the last line of 2022 entries and goes through the same sequence.

Private Sub CommandButton1_Click()
  ' Get the worksheets
    Dim shRead1 As Worksheet
    Dim shRead2 As Worksheet
    Dim shWrite As Worksheet
    Dim Lastrow As Long
    '*******
    Dim lr As Range
    '*******
    
    Set shRead1 = ThisWorkbook.Worksheets("Personnel")
    Set shRead2 = ThisWorkbook.Worksheets("This_year")
    Set shWrite = ThisWorkbook.Worksheets("Hstry")
    
    Set Lastrow = shWrite.Range("A:A").End(xlUp).EntireRow
    
    If Lastrow = Year(Now()) Then
    MsgBox "aready exist"
    Else
    MsgBox "go ahead and Paste"
    
 ' This will copy the values only
    
    shRead1.Range("P3:P66").Copy 'Reads current year
    shWrite.Range("A" & Lastrow + 1).PasteSpecial xlPasteValues
   shRead2.Range("A3:H65").Copy
   shWrite.Range("B" & Lastrow + 1).PasteSpecial xlPasteValues
    
MsgBox "Transfer Successful"
End If
End Sub

 

[bebo021999]

Since Lastrow was declared as long, then replace
Set Lastrow = shWrite.Range("A:A").End(xlUp).EntireRow
with
Lastrow = shWrite.Cells(Rows.Count,"A").End(xlUp).Row

Then you code become:

Private Sub CommandButton1_Click()
  ' Get the worksheets
    Dim shRead1 As Worksheet
    Dim shRead2 As Worksheet
    Dim shWrite As Worksheet
    Dim Lastrow As Long
    '*******
    Set shRead1 = ThisWorkbook.Worksheets("Personnel")
    Set shRead2 = ThisWorkbook.Worksheets("This_year")
    Set shWrite = ThisWorkbook.Worksheets("Hstry")
    With shWrite
        Lastrow = .Cells(Rows.Count,"A").End(xlUp).Row
        If .Cells(Lastrow,"A") = Year(Now()) Then
            MsgBox "aready exist"
            exit sub
        Else
      ' This will copy the values only
              shRead1.Range("P3:P66").Copy 'Reads current year
              .Range("A" & Lastrow + 1).PasteSpecial xlPasteValues
              shRead2.Range("A3:H65").Copy
              .Range("B" & Lastrow + 1).PasteSpecial xlPasteValues
              MsgBox "Transfer Successful"
       End If
   End With
End Sub

 

[erutherford]

Lets see. No errors, everything is copying to the right place, but it still copies regardless of the current year being in Col A. I added the msgBox just for testing.

With shWrite
        Lastrow = .Cells(Rows.Count, "A").End(xlUp).Row
        If .Cells(Lastrow, "A") = Year(Now()) Then
            MsgBox "aready exist"
            Exit Sub
        Else
        MsgBox "should have exit earlier"
      ' This will copy the values only
              'shRead1.Range("P3:P66").Copy 'Reads current year
              '.Range("A" & Lastrow + 1).PasteSpecial xlPasteValues
             ' shRead2.Range("A3:H65").Copy
             '.Range("B" & Lastrow + 1).PasteSpecial xlPasteValues
              MsgBox "Transfer Successful"
       End If
   End With

 

[erutherford]

I suspect the problem is in the formatting of Col A. Currently it is formatted for the date displaying the year only (yyyy). If I format Col A. for "general" and replace "=year now())" with a number, the code works as it should. So its either the format of the Column or the "=year now())" code. I think?

 

[erutherford]

Solved (I think). Looked to see where the original "year" date was created. Its format code was "=Now()". The column was formatted "yyyy". Changed the format code to "=Year(Now())", cleared the Column of its format (back to "General") and bebo's code worked perfect. As to why is above my pay grade!

Thanks bebo and this amazing forum, nothing better exist!