Selected Answer
Hi again Ali M
Correction #1 08 February 2025
Unfortunately the wording of your Question (and Discussions) is confusing, even though the Question is based on a previous Answer from me.
You have confirmed that want to have a FORM sheet for just one calendar year and - in January say- don't want to test/copy the data for the preceding December month.
Accordingly I've modified the code so that the flag "previousCopied" is set if Jan is selected in ComboBox1 .I've also changed some other bits of the code so it works as your examples file showed (see changes in bold):
Option Base 1
Private Sub CommandButton1_Click()
Dim i As Long
Dim lastrow As Long
Dim sheet2 As Worksheet
Dim currentMonth As Date
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"
' set headerswritten flag
headersWritten = True
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 = WorksheetFunction.EoMonth(Date, -1) + 1
Dim alreadyCopied As Boolean, previousCopied As Boolean, prevMonth As Date
prevMonth = WorksheetFunction.EoMonth(Date, -2) + 1
alreadyCopied = False
previousCopied = False
' Force flag if January was selected in ComboBox1
If Left(ComboBox1.Text, 3) = "Jan" Then previousCopied = True
For i = 2 To lastrow
' check if previous month was copied...
If sheet2.Cells(i, 1).Value = prevMonth Then previousCopied = True
'check if current month was copied
If sheet2.Cells(i, 1).Value = currentMonth Then alreadyCopied = True
Next i
If alreadyCopied Then
MsgBox "The data has already been copied for this month!", vbExclamation
Exit Sub
End If
If previousCopied = False Then
MsgBox "The data for " & Format(prevMonth, "Mmm-yy") _
& " cannot be found." & vbCr & "This will be copied first of all", vbExclamation
' jump to placeholder to insert data
GoTo DoPrevious
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
' placeholder for copying missed previous month
DoPrevious:
' 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"
End If
' adjust lastrow to avoid gap for first data set
If lastrow = 1 Then lastrow = 0
' determine which month to record
If previousCopied = False Then
currentMonth = prevMonth
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 " & Format(currentMonth, "Mmm-yy"), vbInformation
Else
MsgBox "Warning: You can only copy data between the 27th and 31st of the month.", vbExclamation
Exit Sub
End If
End Sub
The changes are made in the new modified file attached. I also chnaged the dates in sheet SS from 2023 to 2025.
I note that the code doesn't really check that the ComboBox1 selection actually matches the current month (perhaps for test reasons) but I have NOT changed that.
Hope this helps. If so, please remember to mark this Answer as Selected.