problem formatting when copy from userform

Ali M

Replacement Answer #1 04 December 2024

Following  your clarifications, I've now attached a DEMO file to show how the date copying works (without your various date tests etc.). it this, I've commented out several lines  (where the very first character is a single apostrophe '), like this:

'    copyDate = Date

(You'll need to remove those first apostrophes (only) to get your full code working.

In the revised CommandButton1_Click() code below (and in the attached file):

1. The line to determine lastrow has been moved to after your test 
2. There's a new test to write headers if theres already data on the sheet
3. The counter to write from the ListBox starts with i=1 (so skipping the headrer row of that list)
4. a new line is added to "refresh the screen" since otherwise only part of the data is visible until the MessageBox has be okayed).

See changes in bold (but remember several lines also have the very first character as a single apostrophe): 

Option Base 1

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

Now, CommandButton1 on the UserForm will add the current month data repeatedly to the existing data (without any Month selection or the >27 day test) to either the existing month data or to an empty sheet (if you delete the data in the file I've sent).

Once you've seen that the code works "properly" (for test purposes), you'll need to remove those  very first single apostrophes (only- not ones with are after the first character)

Hope this helps. If so, please remember to mark this Answer as Selected.