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

K

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: 16
  • Capture 2.PNG
    Capture 2.PNG
    88.5 KB · Views: 16
  • Capture 3.PNG
    Capture 3.PNG
    38.1 KB · Views: 18

Excel Facts

How to fill five years of quarters?
Type 1Q-2023 in a cell. Grab the fill handle and drag down or right. After 4Q-2023, Excel will jump to 1Q-2024. Dash can be any character.
Sort by date Sort by votes
@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
Snakehips said:
@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.
Click to expand...
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
KK Wong said:
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))
Click to expand...
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
Snakehips said:
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.
Click to expand...
Thanks so much for the explanation! All clear now.
 
Upvote 0
You must log in or register to reply here.

Similar threads

S
  • Solved
Seperate Data In One Cell Across Multiple Cells
Replies
6
Views
2K
Alex Blakenburg
A
N
  • Solved
Sequential numbers based on cell value
Replies
5
Views
785
jtakw
jtakw
M
  • Question Question
VBA: Grouping Characters by 4 Characters and Formatting Cell That Reaches Limit
Replies
1
Views
529
mikerickson
mikerickson
R
  • Question Question
Mail merge to insert the picture in the mail body and schedule the email
Replies
0
Views
1K
rafeek4u
R
H
  • Question Question
Using excel vba macro to trigger for PM due date
Replies
4
Views
2K
huat
H

Forum statistics

Threads
1,224,818
Messages
6,181,152
Members
453,021
Latest member
Justyna P

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