copy data from listbox on form to sheet based on restrictions

A

Ali M

Active Member
Joined
Oct 10, 2021
Messages
356
Office Version
  1. 2019
  2. 2013
Platform
  1. Windows
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
1.PNG



result in sheet
Sample 2 v0 a.xlsm
ABCD
1MONTHITEMNAMEBALANCE
2Jan-251ALI -10,000.00
32ALILA1,000.00
4TOTAL-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.
1.PNG

result in form sheet.
Sample 2 v0 a.xlsm
ABCD
1MONTHITEMNAMEBALANCE
2Jan-251ALI -10,000.00
32ALILA1,000.00
4TOTAL-9,000.00
5
6MONTHITEMNAMEBALANCE
7Feb-251ALI -10,000.00
82ALILA1,000.00
9TOTAL-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
ABCD
1MONTHITEMNAMEBALANCE
2Jan-251ALI -10,000.00
32ALILA1,000.00
4TOTAL-9,000.00
5
6MONTHITEMNAMEBALANCE
7Feb-251ALI -10,000.00
82ALILA1,000.00
9TOTAL-9,000.00
10
11MONTHITEMNAMEBALANCE
12Mar-251ALI -10,000.00
132ALILA1,000.00
14TOTAL-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.
 

Excel Facts

Easy bullets in Excel
If you have a numeric keypad, press Alt+7 on numeric keypad to type a bullet in Excel.
Sort by date Sort by votes
I didn't do much testing, so it's up to you to do enough testing to verify operation. 😅

VBA Code: 
Private Sub CommandButton1_Click()
  Dim currMonth As Date, prevMonth As Date
  Dim nDay As Long
  Dim f As Range
  
  currMonth = DateSerial(Year(Date), Month(Date), 1)
  'currMonth = DateSerial(Year(Date), 3, 1)
  
  nDay = Day(Date)
  'nDay = 27
  
  If nDay < 27 Then
  
    'check the previous month
    
    prevMonth = DateSerial(Year(Date), 2, 1)
    Set f = Range("A:A").Find(prevMonth, , xlFormulas, xlWhole)
    If f Is Nothing Then
      'if not exists previous month
      '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 current month
    Set f = Range("A:A").Find(currMonth, , xlFormulas, xlWhole)
    If Not f Is Nothing Then
      MsgBox MonthName(Month(Date)) & " 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 Sub

Sub CopyDataFromListbox(nMonth As Date)
  Dim lr As Long, i As Long
  
  lr = Range("B" & Rows.Count).End(3).Row + 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

🫡
 
Upvote 0
thanks Dante for writing code for me.
well I can't show all of conditions, because gives me wrong month!
it copy data to sheet showing Feb-25 but the current month is JAN-25 and shouldn't copy to sheet because the day of date is 10/01/2024 and the restriction should one of days(27,2829,30,31).
 
Upvote 0
Ali M said:
it copy data to sheet showing Feb-25
Click to expand...
The data from my tests remained in the code 😅
Just change this line:
VBA Code: 
prevMonth = DateSerial(Year(Date), 2, 1)

For this:
VBA Code: 
prevMonth = DateSerial(Year(Date), Month(Date) - 1, 1)

🫡
 
Upvote 0
it doesn't show me missed month FEB !:rolleyes:
Sample.xlsm
ABCD
3MONTHITEMNAMEBALANCE
4يناير-251ALI -10,000.00
52ALILA1,000.00
63omar1,000.00
7TOTAL-8,000.00
8
9MONTHITEMNAMEBALANCE
10مارس-251ALI -10,000.00
112ALILA1,000.00
123omar1,000.00
13TOTAL-8,000.00
FORM
 
Last edited:
Upvote 0
What is the sequence of your test?

That is, can you explain step by step what you did to make January and March appear, and what data do you have so that you want February to appear?
 
Upvote 0
ok
when the current month in laptop is Jan and day of date 28 then will copy after that I change current month in laptop to become MAR and the day is 29 then should copy missed FEB month as long as the FEB month is left and enter copy MAR month.
 
Upvote 0
Try:

VBA Code: 
Private Sub CommandButton1_Click()
  Dim currMonth As Date, prevMonth As Date
  Dim nDay As Long
  Dim f As Range
  
  currMonth = DateSerial(Year(Date), Month(Date), 1)
  'currMonth = DateSerial(Year(Date), 4, 1)
  
  nDay = Day(Date)
  'nDay = 26
  prevMonth = DateSerial(Year(currMonth), Month(currMonth) - 1, 1)
  
  If nDay < 27 Then
  
    'check the previous month
    Set f = Range("A:A").Find(prevMonth, , xlFormulas, xlWhole)
    If f Is Nothing 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
    Set f = Range("A:A").Find(prevMonth, , xlFormulas, xlWhole)
    If f Is Nothing 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 + 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

🫡
 
Upvote 0
still problem
missed Jan month
steps:
1- current month Jan and day is 10 then will copy missed month DEC-24 is ok
2- change current month to 28 MAR so will copy FEB-25 and when try again will copy MAR-25 is ok except ignoring JAN-25 is missed!
Sample.xlsm
ABCD
3MONTHITEMNAMEBALANCE
4ديسمبر-241ALI -10,000.00
52ALILA1,000.00
63omar1,000.00
7TOTAL-8,000.00
8
9MONTHITEMNAMEBALANCE
10فبراير-251ALI -10,000.00
112ALILA1,000.00
123omar1,000.00
13TOTAL-8,000.00
14
15MONTHITEMNAMEBALANCE
16مارس-251ALI -10,000.00
172ALILA1,000.00
183omar1,000.00
19TOTAL-8,000.00
FORM
 
Upvote 0
Ali M said:
2- change current month to 28 MAR so will copy FEB-25 and when try again will copy MAR-25 is ok except ignoring JAN-25 is missed!
Click to expand...
So in your process you forgot 2 months!!! :eek:

Do you want the macro to go back in time to see which month you forgot?
And since that is not specified in your OP, then it will only be verified until January of the current year. :unsure: And I mean how many months to go back.

Copy all the code, I added a new function at the end of the code.
VBA 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 = 27
  
  '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

🫡
 
Upvote 0
You must log in or register to reply here.

Similar threads

A
  • Question Question
Pops message box when run userform based on days for current month
Replies
0
Views
68
Ali M
A
A
  • Question Question
How restrict copy data from form to sheet based on five days within current month
Replies
3
Views
148
Ali M
A
A
  • Question Question
Modifying code for message box on userform based on selected combobox
Replies
0
Views
107
Ali M
A
A
  • Solved
Select current month in combobox on userform for English language
2 3
Replies
29
Views
500
Ali M
A
S
  • Question Question
Multiple columns lookup
Replies
0
Views
301
Sipirili2504
S

Forum statistics

Threads
1,225,374
Messages
6,184,604
Members
453,246
Latest member
PEM000

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top