need procedure by message box to inform what exactly missed month

[Ali M]

Hi,
I would add procedure to code when try copy current month and there is missed month within JAN-DEC then inform me what exactly month are missed

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

AFTER (2).xlsm
	A	B	C	D
1	MONTH	ITEM	NAME	BALANCE
2	Jan-25	1	ALI	-10000
3		2	ALILA	1000
4		TOTAL		-9000
Sheet2

and if the current month is APR then will show message" you have three months are missed !, "they are FEB,MAR" after message is gone then complete running code.
thanks

 

[DanteAmor]

Try:

Private Sub CommandButton1_Click()
  Dim currMonth As Date, prevMonth As Date
  Dim nDay As Long, nMon As Long, nCount As Long
  Dim cad As String, msg As String
  Dim f As Range
  
  currMonth = DateSerial(Year(Date), Month(Date), 1)   'comment this line
  'currMonth = DateSerial(Year(Date), 4, 1)              'change 4 to March
  
  nDay = Day(Date)                                     'comment this line
  'nDay = 10                                             'change 10
  
  'prevMonth = DateSerial(Year(currMonth), Month(currMonth) - 1, 1)
  'nMon = WhichMonthIsMissing(Month(currMonth) - 1)
  cad = WhichMonthIsMissing(Month(currMonth) - 1)
  If cad <> "" Then
    nMon = Split(cad, "|")(0)
    nCount = Split(cad, "|")(1)
    msg = "You have " & nCount & " months are missed, they are: " & vbCr & _
      Split(cad, "|")(2)
  Else
    msg = "There are no missing months"
  End If
  MsgBox msg, vbExclamation
  
  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 String
  Dim f As Range, i As Long, dt As Date
  Dim cad As String, nFirst As Long, nCount As Long
  
  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
      cad = cad & MonthName(i, True) & ", "
      nCount = nCount + 1
      If nFirst = 0 Then nFirst = i
      'WhichMonthIsMissing = i
      'Exit Function
    End If
  Next
  If cad <> "" Then
    WhichMonthIsMissing = nFirst & "|" & nCount & "|" & Left(cad, Len(cad) - 2)
  End If
End Function

 

[Ali M]

great !
many thanks for your help.