Hello,
I search for way when there is missed month before current month, then will not copy for current month before copy the prevoius month but first of all should informe me by message" there is missed month NOVE-24 should copy first of all" after is gone the message then will copy data for the prevoius month NOVE-24 , if there is no missed month before current month , then will not do anything.
example : inside sheet I have OCTOBER month and the current month is DECEMBER,so the code will copy data based on current month is DECEMBER but there is missed month for prevouis month is NOVEMEBER . in this case will show message and copy. as to current month DECEMBER will copy based on condition inside code for days 27,28,29,30,31 .
Private Sub CommandButton1_Click()
Dim i As Long
Dim lastrow As Long
Dim sheet2 As Worksheet
Dim currentMonth As String
Dim copyDate As Date
Dim remainingDays As Long
Dim headersWritten As Boolean
Set sheet2 = ThisWorkbook.Sheets("FORM") ' Replace with the correct sheet name if necessary
' lastrow line moved down
' Check if headers are already written
headersWritten = (sheet2.Cells(1, 1).Value = "MONTH" And sheet2.Cells(1, 2).Value = "ITEM" _
And sheet2.Cells(1, 3).Value = "NAME" And sheet2.Cells(1, 4).Value = "BALANCE")
' Write headers if not already present
If Not headersWritten Then
sheet2.Cells(1, 1).Value = "MONTH"
sheet2.Cells(1, 2).Value = "ITEM"
sheet2.Cells(1, 3).Value = "NAME"
sheet2.Cells(1, 4).Value = "BALANCE"
End If
' Determine the last row
lastrow = sheet2.Cells(sheet2.Rows.Count, 1).End(xlUp).Row
' Check if this month has already been copied
currentMonth = Format(Date, "mmm-yy")
Dim alreadyCopied As Boolean
alreadyCopied = False
For i = 2 To lastrow
If sheet2.Cells(i, 1).Value = currentMonth Then
alreadyCopied = True
Exit For
End If
Next i
If alreadyCopied Then
MsgBox "The data has already been copied for this month!", vbExclamation
Exit Sub
End If
' Check if today is within the allowed days
copyDate = Date
If Day(copyDate) < 27 Then
remainingDays = 27 - Day(copyDate)
MsgBox "Warning: You need to wait " & remainingDays & " more days to copy the data.", vbExclamation
Exit Sub
ElseIf Day(copyDate) >= 27 And Day(copyDate) <= 31 Then
' Copy data from ListBox1 to Sheet2
With Me.ListBox1
' write headers if not already done
If headersWritten Then
sheet2.Cells(lastrow + 1, 1).Value = "MONTH"
sheet2.Cells(lastrow + 1, 2).Value = "ITEM"
sheet2.Cells(lastrow + 1, 3).Value = "NAME"
sheet2.Cells(lastrow + 1, 4).Value = "BALANCE"
Else
' adjust lastrow to avoid gap for first data set
lastrow = 0
End If
' write month data
For i = 1 To .ListCount - 1
sheet2.Cells(lastrow + i + 1, 1).Value = currentMonth
sheet2.Cells(lastrow + i + 1, 2).Value = .List(i, 0)
sheet2.Cells(lastrow + i + 1, 3).Value = .List(i, 1)
sheet2.Cells(lastrow + i + 1, 4).Value = .List(i, 2)
' lastrow = lastrow + 1
Next i
' refresh the screen
Application.ScreenUpdating = True
End With
MsgBox "Data successfully copied for " & currentMonth, vbInformation
Else
MsgBox "Warning: You can only copy data between the 27th and 31st of the month.", vbExclamation
Exit Sub
End If
End Sub
I hope finding help for this requirements.