(VBA) Write multiple texts if they don't exist in a cell range

KK Wong

New Member
Joined
Dec 17, 2020
Messages
16
Office Version
  1. 365
Platform
  1. Windows
Hello! In my work duty, I need to maintain a workbook that monitors the payment status of my client accounts. Basically, at the end of each month, I will check our internal system to see whether the client has sent us email for payment. If the client does, we need to record the months of our services for which that client's payment is made.

Details (I could not use the XL2BB... so I uploaded 3 photos for demo)
1. Column A is for the client number.
2. B1 is last year. N1 is current year.
3. B2:M2 is for the months of the last year. N2:Y2 is the for the months of the current year.
4. Then, if the cell is shown as "EMPTY", that means there is no email sent for payment by the client in that column of month. Take the first client for example, no email is sent to us in April 2020.
5. If the cell shows value, it will be in a standard format as "YYYYMMM". Take the first client for example, in cell J3, the cell value is "2020AUG", meaning that in 2020 September, the client sent us an email for the payment for the services we provided in August 2020.
6. There could be more than one month in the same cell. For example, in cell F3, the cell value is "2020MAR;2020APR;2020MAY". It means in May 2020, the client sent an email for three payments for the services provided from 2020 Mar to 2020 May.
7. In some months, no services was provided to the client. However, the client still needs to send us an email to inform. For example, in cell O3, the cell value is "2020DEC(nil)". That means in Feb 2021, the client informed us that no services was provided in Dec 2020. As long as they inform us about the months, those months shouldn't be regarded as outstanding months.

What I want to do in the VBA:
1. Count the number of months in which payment is outstanding, and put it in Column Z. Take the first client for example, between Jan 2020 and Jun 2021, only 2 months are not found in the cells (i.e. 2021MAY and 2021 JUN). Therefore, the outstanding number should be 2.
2. Remark the corresponding outstanding months under Column AA. In the above case, just write 2021MAY; 2021JUN.
As you can see in Photo 3...
--------------------------------------------------------------------------
I did try to build the code, but it's a bit clumsy and I stuck at some point...

VBA Code:
'Date Setting
Dim YearOnly As String, LastYear As String, MonthOnly As String, DateName As String

    DateName = Format(Date, "yyyyMMM")
    MonthOnly = Format(Date, "MMM")
    YearOnly = Format(Date, "yyyy")
    LastYear = Format(DateAdd("yyyy", -1, Date), "yyyy")
    
        'Find the Coloumn of the Current Year
        With Range("N2:Y2")
            Set ThisPos = .Find(What:=MonthOnly, LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False)
            If Not ThisPos Is Nothing Then
            Cell_Add = Split(ThisPos.Address, "$")
            MonthColumn = Cell_Add(1)
            End If
        End With

        'Setting initial number of Oustanding Months
        If MonthColumn = "N" Then
        OutstandingMonth = "13"
        ElseIf MonthColumn = "O" Then
        OutstandingMonth = "14"
        ElseIf MonthColumn = "P" Then
        OutstandingMonth = "15"
        ElseIf MonthColumn = "Q" Then
        OutstandingMonth = "16"
        ElseIf MonthColumn = "R" Then
        OutstandingMonth = "17"
        ElseIf MonthColumn = "S" Then
        OutstandingMonth = "18"
        ElseIf MonthColumn = "T" Then
        OutstandingMonth = "19"
        ElseIf MonthColumn = "U" Then
        OutstandingMonth = "20"
        ElseIf MonthColumn = "V" Then
        OutstandingMonth = "21"
        ElseIf MonthColumn = "W" Then
        OutstandingMonth = "22"
        ElseIf MonthColumn = "X" Then
        OutstandingMonth = "23"
        ElseIf MonthColumn = "Y" Then
        OutstandingMonth = "24"
        End If

        'Find Month
        LastRow = Range("A" & Rows.Count).End(xlUp).Row
        FindLYJan = LastYear & "JAN"
        FindLYFeb = LastYear & "FEB"
        FindLYMar = LastYear & "MAR"
        FindLYApr = LastYear & "APR"
        FindLYMay = LastYear & "MAY"
        FindLYJun = LastYear & "JUN"
        FindLYJul = LastYear & "JUL"
        FindLYAug = LastYear & "AUG"
        FindLYSep = LastYear & "SEP"
        FindLYOct = LastYear & "OCT"
        FindLYNov = LastYear & "NOV"
        FindLYDec = LastYear & "DEC"
        
        FindCYJan = YearOnly & "JAN"
        FindCYFeb = YearOnly & "FEB"
        FindCYMar = YearOnly & "MAR"
        FindCYApr = YearOnly & "APR"
        FindCYMay = YearOnly & "MAY"
        FindCYJun = YearOnly & "JUN"
        FindCYJul = YearOnly & "JUL"
        FindCYAug = YearOnly & "AUG"
        FindCYSep = YearOnly & "SEP"
        FindCYOct = YearOnly & "OCT"
        FindCYNov = YearOnly & "NOV"
        FindCYDec = YearOnly & "DEC"

        'Count outstanding months
        For i = 2 To LastRow
            Set Rng = Range("B" & i & ":" & MonthColumn & i)
                
                For Each Cell In Rng.Cells
                If UCase(Cell.Value) Like "*" & UCase(FindLYJan) & "*" Then
                OutstandingMonth = OutstandingMonth - 1
                End If
                If UCase(Cell.Value) Like "*" & UCase(FindLYFeb) & "*" Then
                OutstandingMonth = OutstandingMonth - 1
                End If
                If UCase(Cell.Value) Like "*" & UCase(FindLYMar) & "*" Then
                OutstandingMonth = OutstandingMonth - 1
                End If
                '.
                '.
                '.
                'I will skip the rest here. Basically, by this approach I will need to create 24 If-Conditions to find if the cells contain the months. 
                
                Next
            
        Next i
 

Attachments

  • Capture1.PNG
    Capture1.PNG
    99.5 KB · Views: 13
  • Capture 2.PNG
    Capture 2.PNG
    88.5 KB · Views: 14
  • Capture 3.PNG
    Capture 3.PNG
    38.1 KB · Views: 16

Excel Facts

What did Pito Salas invent?
Pito Salas, working for Lotus, popularized what would become to be pivot tables. It was released as Lotus Improv in 1989.
@KK Wong

Maybe give this a try.

VBA Code:
Sub Wong()

Dim YearOnly, CheckStr, MonthList As String
Dim r, c, LastRow As Long
Dim OutstandingMonth, MonthColumn As Integer

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False

'Current year
YearOnly = Format(Date, "yyyy")
'Find the Coloumn of the Current month (Col N = Col 14) so
 
 MonthColumn = Month(Date) + 13
 
'Last data row
 LastRow = Range("A" & Rows.Count).End(xlUp).row
      
'For each row/account
For r = 3 To LastRow
OutstandingMonth = MonthColumn - 1
MonthList = ""
CheckStr = ""
    'create string of row r column entries to check against
    For c = 2 To MonthColumn
    If Not Cells(r, c) = "EMPTY" Then CheckStr = CheckStr & ";" & UCase(Cells(r, c))
    Next c
                  
         'for each column ie  Year/month
        For c = 2 To MonthColumn
          
            CheckMth = YearOnly + (c < 14) & UCase(Cells(2, c))
               
            'check if year/month entry is in the Check tring
               
                If CheckStr Like "*" & CheckMth & "*" Then
                    OutstandingMonth = OutstandingMonth - 1
                Else
                    MonthList = MonthList & ";" & CheckMth
                End If
                             
        Next c
               
   Cells(r, 26) = OutstandingMonth
   Cells(r, 27) = Right(MonthList, Len(MonthList) - 1)
Next r
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

Hope that helps.
 
Upvote 0
Solution
@KK Wong

Maybe give this a try.

VBA Code:
Sub Wong()

Dim YearOnly, CheckStr, MonthList As String
Dim r, c, LastRow As Long
Dim OutstandingMonth, MonthColumn As Integer

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False

'Current year
YearOnly = Format(Date, "yyyy")
'Find the Coloumn of the Current month (Col N = Col 14) so
 
 MonthColumn = Month(Date) + 13
 
'Last data row
 LastRow = Range("A" & Rows.Count).End(xlUp).row
     
'For each row/account
For r = 3 To LastRow
OutstandingMonth = MonthColumn - 1
MonthList = ""
CheckStr = ""
    'create string of row r column entries to check against
    For c = 2 To MonthColumn
    If Not Cells(r, c) = "EMPTY" Then CheckStr = CheckStr & ";" & UCase(Cells(r, c))
    Next c
                 
         'for each column ie  Year/month
        For c = 2 To MonthColumn
         
            CheckMth = YearOnly + (c < 14) & UCase(Cells(2, c))
              
            'check if year/month entry is in the Check tring
              
                If CheckStr Like "*" & CheckMth & "*" Then
                    OutstandingMonth = OutstandingMonth - 1
                Else
                    MonthList = MonthList & ";" & CheckMth
                End If
                            
        Next c
              
   Cells(r, 26) = OutstandingMonth
   Cells(r, 27) = Right(MonthList, Len(MonthList) - 1)
Next r
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

Hope that helps.
That's perfectly what I needed... Thank you so much for the clear and concise codes. I just have one question.

How does the following line work? Why does (YearOnly + (c<14)) know to return 2020 & 2021 correctly?
CheckMth = YearOnly + (c < 14) & UCase(Cells(2, c))
 
Upvote 0
That's perfectly what I needed... Thank you so much for the clear and concise codes. I just have one question.

How does the following line work? Why does (YearOnly + (c<14)) know to return 2020 & 2021 correctly?
CheckMth = YearOnly + (c < 14) & UCase(Cells(2, c))
You are welcome. Glad it worked.
As for the question.
Code calculates YearOnly to give current year. 2021
2021 starts in column N. column 14 so when c =14 or greater it is 2021
Columns B:M. or 2:13 are 2020
Could have written an if statement to query c and return the correct year but is less code /more efficient to do it mathematically with one line.

(c<14) queries c relative to 14
If c is less than 14, (c<14) returns TRUE and when used as part of a mathematical expression, eg +(c<14), TRUE converts to -1
If c is equal or greater than 14, (c<14) returns FALSE and when used as part of a mathematical expression, eg +(c<14), FALSE converts to 0

Thus, YearOnly is either +(0) = 2021 or YearOnly +(-1) =2020

Try typing ?(3<14) in the Immediate pane of your vba editor. Then hit return.
Then edit it to ?+(3<14) or ?*(3<14)
Then try with ?(15<14)

Hope that helps.
 
Upvote 0
You are welcome. Glad it worked.
As for the question.
Code calculates YearOnly to give current year. 2021
2021 starts in column N. column 14 so when c =14 or greater it is 2021
Columns B:M. or 2:13 are 2020
Could have written an if statement to query c and return the correct year but is less code /more efficient to do it mathematically with one line.

(c<14) queries c relative to 14
If c is less than 14, (c<14) returns TRUE and when used as part of a mathematical expression, eg +(c<14), TRUE converts to -1
If c is equal or greater than 14, (c<14) returns FALSE and when used as part of a mathematical expression, eg +(c<14), FALSE converts to 0

Thus, YearOnly is either +(0) = 2021 or YearOnly +(-1) =2020

Try typing ?(3<14) in the Immediate pane of your vba editor. Then hit return.
Then edit it to ?+(3<14) or ?*(3<14)
Then try with ?(15<14)

Hope that helps.
Thanks so much for the explanation! All clear now.
 
Upvote 0

Forum statistics

Threads
1,213,526
Messages
6,114,136
Members
448,551
Latest member
Sienna de Souza

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