Compare two columns and fill in a third column I want to find out the records with same group from Column AS in Column AT and add missing invoices in Column AU considering all the values from the group in Column as below table:

Jan|Feb|Mar|ColumnAS|ColumnAT|ColumnAU

$30|blank|blank|AAA|AAA|Feb

blank|blank|blank|AAA|blank|blank 

blank|blank|$35|AAA|blank|blank 

blank|blank|blank|AAB|AAB|Jan,Mar 

blank|$20|blank|AAB|blank|blank 

blank|blank|blank|AAB|blank|blank

I have created 2 loops one (j) which runs through all values from Column AS and other (k) through AT. Temp2 is used to add unique values to column AT after comparing values from temp1

Code:

Sub MissingMonth()
Dim wSheet As Worksheet
Dim LastRow As Long
Dim temp1 As String
Dim temp2 As String
Dim j As Long, k As Long

Set wSheet = ThisWorkbook.Sheets("Source Data")
     wSheet.Select

        LastRow = ThisWorkbook.Sheets("Source Data").Cells(Rows.Count, "A").End(xlUp).Row

        temp2 = vbNullString
        For j = 2 To LastRow

            If Not (wSheet.Range("AS" &amp; j) = temp2) Or temp2 = vbNullString Then
                temp1 = wSheet.Range("AS" &amp; j)
                wSheet.Range("AU" &amp; j) = "Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec"
                For k = 2 To LastRow
                  temp2 = temp1
                  wSheet.Range("AT" &amp; j) = temp2

                    If wSheet.Range("AS" &amp; k) = temp2 Then
                        Call CheckMissingMonth(k, temp2, "I", j, "Jan ")
                        Call CheckMissingMonth(k, temp2, "J", j, "Feb ")
                        Call CheckMissingMonth(k, temp2, "K", j, "Mar ")
                        Call CheckMissingMonth(k, temp2, "L", j, "Apr ")
                        Call CheckMissingMonth(k, temp2, "M", j, "May ")
                        Call CheckMissingMonth(k, temp2, "N", j, "Jun ")
                        Call CheckMissingMonth(k, temp2, "O", j, "Jul ")
                        Call CheckMissingMonth(k, temp2, "P", j, "Aug ")
                        Call CheckMissingMonth(k, temp2, "Q", j, "Sep ")
                        Call CheckMissingMonth(k, temp2, "R", j, "Oct ")
                        Call CheckMissingMonth(k, temp2, "S", j, "Nov ")
                        Call CheckMissingMonth(k, temp2, "T", j, "Dec")

                    End If
                 Next k
             End If
          Next j
 Set wSheet = Nothing
End Sub

  Sub CheckMissingMonth(k As Long, TempMonth As String, ColumnName As String, j As Long, Replacevalue As String)
     If Not IsEmpty(ThisWorkbook.Sheets("Source Data").Cells(k, ColumnName)) Then
        ThisWorkbook.Sheets("Source Data").Range("AU" &amp; j).Replace What:=Replacevalue, Replacement:="", LookAt:=xlPart, MatchCase:=False
   End If
End Sub
This is how I understand the requirements

Before


After



Column A is required (implied by how last row is determined)
Light red = group 1 (AAA); dark red = missing months for group 1
Light blue = group 2 (AAB); dark blue = missing months for group 2
If current record is in the same as group as previous don't update columns AT and AU




About the posted code

I found the logic a bit convoluted and hard follow (or maintain)


Indentation is inconsistent
Naming convention doesn't provide many clues for intent, examples:


MissingMonth() should be FindMissingMonths() or ShowMissingMonth()
temp1 and temp2 don't imply anything helpful, yet temp2 is critical
Usual loop counters are i, j, k (nesting hierarchy) - probably i was used at some point, then removed
LastRow (local variable names) should start with a lower case letter

temp1 is not needed
wSheet is assigned but in the LastRow assignment wSheet is not used:

LastRow = ThisWorkbook.Sheets("Source Data").Cells(Rows.Count, "A").End(xlUp).Row

should be

LastRow = wSheet.Cells(wSheet.Rows.Count, "A").End(xlUp).Row
in sub CheckMissingMonth(), parameter TempMonth is not used
there are too many interactions with the sheet, especially when calling CheckMissingMonth() and they cause slowness




This is how I would improve it for compactness and maintainability (and a bit for performance):

Version 1

Option Explicit

Public Sub findMissingMonths()
    Const JAN = 9   'start column
    Dim lastRow As Long, i As Long, j As Long, k As Long, miss As String, rng As Range
    Dim prevAS As String, mths As String, mthArr As Variant, lastMonth As Byte

    With ThisWorkbook.Sheets("Source Data")
        Set rng = .Range(.Cells(1, JAN), .Cells(1, JAN + 11)) 'get all months from headers
        mths = Join(WorksheetFunction.Transpose(WorksheetFunction.Transpose(rng)))
        mthArr = Split(mths)    '"Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec"

        lastMonth = UBound(mthArr)
        lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row

        For i = 2 To lastRow                'check colAS (continue only if new group)
            If .Range("AS" &amp; i).Value2 &lt;&gt; prevAS Or Len(prevAS) = 0 Then
                miss = mths                 'working string to remove the month from
                For j = 2 To lastRow        'check colAT
                    prevAS = .Range("AS" &amp; i).Value2    'remember previous val in colAS
                    .Range("AT" &amp; i).Value2 = prevAS
                    For k = 0 To lastMonth  'del month from full str as needed
                        If .Range("AS" &amp; j).Value2 = prevAS Then
                          If Len(.Cells(j, JAN + k).Value2) &gt; 0 Then
                            miss = Replace(Replace(miss, mthArr(k), ""), "  ", " ")
                          End If
                        End If
                    Next k
                Next j
                .Range("AU" &amp; i).Value2 = Trim(miss)    'commit to cell
            End If
        Next i
    End With
End Sub




.

To optimize for performance I would eliminate all range interactions except for moving all data to memory and, at the end, placing it back on the sheet. This requires a bit more effort and code but the benefit is exponential

Here is another version optimized for speed, and this is the flow at high level:


move all data to array (variant)
create a nested dictionary that will keep track of each month value for each group:
AAA


Jan = Present (boolean)
Feb = Missing
Mar = Present
...

AAB


Jan = Missing
Feb = Missing
Mar = Present
...

first loop:


read all groups from col AS (also in memory as a smaller variant array)
initialize all values to False

second loop:


read all months' data and update all dictionary values to True as needed
update col AT and AU as needed (from dictionaries to array)

write all array data back to the sheet




Example (including all helper functions in the same module):

Version 2

Option Explicit

Private Const MONTHS As String = "Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec"
Public Sub showMissingMonths()      'in VBE set reference to "Microsoft Scripting Runtime"
    Const COL_I     As Long = 9     'Month columns I to T (9 to 20)
    Const COL_AS    As Long = 45    'Work columns AS to AU (45 to 47)
    Dim ws As Worksheet, arr As Variant, missing As String
    Dim i As Long, j As Long, lastRow As Long, unique As Dictionary
    Set ws = ThisWorkbook.Sheets("Source Data")
    arr = ws.UsedRange              'copy the used range to array
    lastRow = UBound(arr)           'first dimmension of the 2D array
    Set unique = getUnique(ws.UsedRange.Columns(COL_AS).Offset(1).Resize(lastRow - 1))
    If unique.Count &gt; 0 Then
        For i = 2 To lastRow        'by row, determine if each month contains a value
            For j = 0 To 11
                If Not unique(arr(i, COL_AS))(arr(1, COL_I + j)) Then
                    unique(arr(i, COL_AS))(arr(1, COL_I + j)) = Len(arr(i, COL_I + j)) &gt; 0
                End If
            Next
        Next
        For i = 2 To lastRow        'update colAU with missing month, only if new group
            If i = 2 Or arr(i - 1, COL_AS) &lt;&gt; arr(i, COL_AS) Then
              missing = vbNullString
              For j = 0 To 11
                If Not unique(arr(i, COL_AS))(arr(1, COL_I + j)) Then
                  missing = missing &amp; arr(1, COL_I + j) &amp; ", "
                End If
              Next
              arr(i, COL_AS + 1) = arr(i, COL_AS)
              If Len(missing) &gt; 0 Then arr(i, COL_AS + 2) = Left(missing, Len(missing) - 2)
            End If
        Next
    End If
    ws.UsedRange = arr              'commit back to range
End Sub




Private Function getUnique(ByRef rng As Range) As Dictionary
    Dim arr As Variant, i As Long, ub As Long, d As Dictionary, val As String
    arr = rng
    ub = UBound(arr)
    getNewDict d        'each group value contains a dictionary with all months
    If ub &gt; 0 Then
        For i = 1 To ub
            val = arr(i, 1)
            If Len(val) &gt; 0 Then If Not d.Exists(val) Then Set d(val) = getMonthDict
        Next
    End If
    Set getUnique = d   'returned dictionary can be empty
End Function




Private Sub getNewDict(ByRef d As Dictionary, Optional ByVal ignoreCase As Boolean = False)
    If Not d Is Nothing Then Set d = Nothing
    Set d = New Dictionary
    d.CompareMode = IIf(ignoreCase, vbTextCompare, vbBinaryCompare)
End Sub




Private Function getMonthDict(Optional ByVal ignoreCase As Boolean = False) As Dictionary
    Dim arr() As String, m As Variant, d As Dictionary
    getNewDict d
    arr = Split(MONTHS)
    For Each m In arr
        d(m) = False
    Next
    Set getMonthDict = d
End Function




PS. In a working module I'd declare all variables on separate lines, use longer and more meaningful names, and add more vertical white-spaces

PS1. Performance measurements:

Tests duration


1,000 records


As posted:29.672 sec
Version 1:53.320 sec
Version 2:0.047 sec

10.000 records


As posted:60.45  min (3,627.328 sec)
Version 1:109.30  min (6,558.547 sec)
Version 2:0.297 sec

100.000 records


Version 2:3.094 sec
Version 2:3.242 sec
Version 2:3.234 sec

1 Million records


Version 2:32.234 sec
Version 2:32.164 sec
Version 2:32.336 sec