copy data from listbox on form to sheet based on restrictions

[Ali M]

Hi experts,
every month for every year I should copy data from lisbox to form.
I have code to show data in list box , what I want .
1- first when show data in listbox1 then copy data from form to sheet for current month based on condition, the condition is when reach specific days for current month (27 or 28 or 29 or 30 or 31) . so one of theses is enough to copy to sheet.
2- when copy to sheet then will add headers (MONTH,NAME,ITEM,BALANCE) ,but for each range

result in sheet

Sample 2 v0 a.xlsm
	A	B	C	D
1	MONTH	ITEM	NAME	BALANCE
2	Jan-25	1	ALI	-10,000.00
3		2	ALILA	1,000.00
4		TOTAL		-9,000.00
FORM

3- if I try copy data when days of dates for current month 27 or 28 or 29 or 30 or 31 and the current month is already copied then well show message" Jan month is already existed, you can't copy again ,sorry!"
4- if I try copy from listbox before days of dates ( 27 or 28 or 29 or 30 or 31) then will not copy from userform to sheet until reach on of days and show message by inform me how many remaining days to reach days of dates ( 27 or 28 or 29 or 30 or 31).
5- if I forgot copy current month for instance FEB and current month is MAR then will copy data for FEB month before.
ignoring conditions days of dates ( 27 or 28 or 29 or 30 or 31) because it leaves and enter new month(MAR) like this.
other meaning any missed month should copy before when try copying current month.

result in form sheet.

Sample 2 v0 a.xlsm
	A	B	C	D
1	MONTH	ITEM	NAME	BALANCE
2	Jan-25	1	ALI	-10,000.00
3		2	ALILA	1,000.00
4		TOTAL		-9,000.00
5
6	MONTH	ITEM	NAME	BALANCE
7	Feb-25	1	ALI	-10,000.00
8		2	ALILA	1,000.00
9		TOTAL		-9,000.00
FORM

after copy FEB month remember I try copy MAR so when doesn't reach days of dates ( 27 or 28 or 29 or 30 or 31) then will show message as I mentioned above.
as you notice there is no current month(MAR) until apply condition for days of dates ( 27 or 28 or 29 or 30 or 31) , if reach days of dates ( 27 or 28 or 29 or 30 or 31) then will be like ,

Sample 2 v0 a.xlsm
	A	B	C	D
1	MONTH	ITEM	NAME	BALANCE
2	Jan-25	1	ALI	-10,000.00
3		2	ALILA	1,000.00
4		TOTAL		-9,000.00
5
6	MONTH	ITEM	NAME	BALANCE
7	Feb-25	1	ALI	-10,000.00
8		2	ALILA	1,000.00
9		TOTAL		-9,000.00
10
11	MONTH	ITEM	NAME	BALANCE
12	Mar-25	1	ALI	-10,000.00
13		2	ALILA	1,000.00
14		TOTAL		-9,000.00
FORM

last thing the data will increase in listbox so when show month in column A then will merge cells until TOTAL word in column B .
I hope finding solution.

 

[Ali M]

Do you want the macro to go back in time to see which month you forgot?

yes , should start from JAN-25 to DEC-25
any missed within them then should copy missed months.
I tested the code when current month 10 MAR then will copy JAN-25, FEB-25 ,MAR-25 . I suppose to shouldn't copy MR-25 because day is 10 !

 

[DanteAmor]

My bad, again I forgot to remove my test data.

Try the following code.

Private Sub CommandButton1_Click()
  Dim currMonth As Date, prevMonth As Date
  Dim nDay As Long, nMon As Long
  Dim f As Range
  
  currMonth = DateSerial(Year(Date), Month(Date), 1)
  'currMonth = DateSerial(Year(Date), 3, 1)
  
  nDay = Day(Date)
  'nDay = 10
  
  'prevMonth = DateSerial(Year(currMonth), Month(currMonth) - 1, 1)
  nMon = WhichMonthIsMissing(Month(currMonth) - 1)
  If nMon > 0 Then prevMonth = DateSerial(Year(currMonth), nMon, 1)
  
  If nDay < 27 Then
    'check the previous month
    If nMon > 0 Then
      'if not exists previous montn. Copy data from listbox to sheet
      Call CopyDataFromListbox(prevMonth)
    Else
      'if exists previous month
      MsgBox "Days left until the date: " & 27 - nDay
    End If
   
  Else  'nday >= 27
    'check the previous month
    If nMon > 0 Then
      'if not exists previous month. Copy data from listbox to sheet
      Call CopyDataFromListbox(prevMonth)
    Else
      'check the current month
      Set f = Range("A:A").Find(currMonth, , xlFormulas, xlWhole)
      If Not f Is Nothing Then
        MsgBox MonthName(Month(currMonth)) & " month is already existed, you can't copy again ,sorry!"
      Else
        'copy data from listbox to sheet
        Call CopyDataFromListbox(currMonth)
      End If
    End If
  End If
End Sub

Sub CopyDataFromListbox(nMonth As Date)
  Dim lr As Long, i As Long
  
  lr = Range("B" & Rows.Count).End(3).Row
  
  If lr > 1 Then lr = lr + 2
  
  With Range("A" & lr).Resize(1, 4)
    .Value = Array("MONTH", "ITEM", "NAME", "BALANCE")
    .Interior.Color = vbYellow
    .Font.Bold = True
  End With
  
  With Range("A" & lr).Resize(ListBox1.ListCount, 4).Borders
    .LineStyle = xlContinuous
    .Color = 11184814
  End With
  
  If ListBox1.ListCount > 2 Then
    With Range("A" & lr + 1)
      .Resize(ListBox1.ListCount - 2).Merge
      .NumberFormat = "mmm-yy"
    End With
  End If
  
  For i = 1 To ListBox1.ListCount - 1
    lr = lr + 1
    If i = 1 Then Range("A" & lr).Value = nMonth
    Range("B" & lr).Value = ListBox1.List(i, 0)
    Range("C" & lr).Value = ListBox1.List(i, 1)
    Range("D" & lr).Value = ListBox1.List(i, 2)
  Next
  
  Range("A:D").HorizontalAlignment = xlCenter
  Range("C:D").NumberFormat = "#,##0.00"
  With Range("B" & lr)
    .Interior.Color = vbYellow
    .Font.Bold = True
  End With
End Sub

Function WhichMonthIsMissing(n As Long) As Long
  Dim f As Range, i As Long, dt As Date
  
  For i = 1 To n
    dt = DateSerial(Year(Date), i, 1)
    Set f = Range("A:A").Find(dt, , xlFormulas, xlWhole)
    If f Is Nothing Then
      WhichMonthIsMissing = i
      Exit Function
    End If
  Next
End Function

 

[Ali M]

I tested when current month is MAR and day is 10 will copy from JAN-25 up to MAR-25 , MAR-25 shouldn't copy !

 

[DanteAmor]

I tested when current month is MAR and day is 10

How do you do the test?


I do the test as follows for 10 March 2025

  'currMonth = DateSerial(Year(Date), Month(Date), 1)   'comment this line
  currMonth = DateSerial(Year(Date), 3, 1)              'change 3 to March
  
  'nDay = Day(Date)                                     'comment this line
  nDay = 10                                             'change 10

After creating January and February in the following execution the result is:

Did you copy all the code from post #12?

I await your comments

 

[Ali M]

now works excellently !
thank you so much.