Matching the values in 3 months then paste the desired text at last month

I was using this code which is matching the values of Col”B” by three months

such as

Aug, Sep, Oct then give the result in sheet “Oct” Col "R" where at Col "Q" , "D" is available

same for next three months

Sep, Oct, Nov code will give the result in sheet “Nov” Col "R" where at Col "Q" , "D" is available

Now i have made the calculation's manually by using Vlookup i found a wrong answer that the code is pasting when I run the code. It paste the “remove” when value is not available in any of sheet rather than “empty”

Solution If three months has same sku then it will paste the "Remove" in 3rd month sheet “Oct” and “Nov” Col “R” and if sku is not available even in one month it will be "empty".

any help would be highly appreciated.

Sub Matching()

Dim row1, month3, month2, month1, Rating3, Rating2, Rating1, sku As String
Dim ws As Worksheet
Dim xa, xb, xc As Integer

xa = 1
xc = Worksheets("Main").Cells(1, 5)
Sheets("Main").Range("A:A").Clear
 
For Each ws In Worksheets
 Sheets("Main").Cells(xa, 1) = ws.Name
 xa = xa + 1
Next ws
Sheets("Main").Range("A2:C8").Sort Key1:=Sheets("Main").Range("B2"), Order1:=xlAscending, Header:=xlNo

For xb = 4 To xc
month3 = Worksheets("Main").Cells(xb, 3)
month2 = Worksheets("Main").Cells(xb - 1, 3)
month1 = Worksheets("Main").Cells(xb - 2, 3)

For x = 2 To 800
If Worksheets(month3).Cells(x, 17) = "D" Then
sku = Worksheets(month3).Cells(x, 2).Text


With Sheets(month3)
 Set Findrow = .Range("B:B").Find(What:=sku, LookIn:=xlValues)
 
If Findrow Is Nothing Then
Rating3 = 0
Else
row1 = Findrow.Row

If Worksheets(month3).Cells(Findrow.Row, 17).Text = "D" Then
Rating3 = 1
Else
End If
End If
End With


With Sheets(month2)
 Set Findrow = .Range("B:B").Find(What:=sku, LookIn:=xlValues)
 If Findrow Is Nothing Then
Rating3 = 0
Else
If Worksheets(month2).Cells(Findrow.Row, 17).Text = "D" Then
Rating2 = 1
Else
End If
End If
End With


With Sheets(month1)
 Set Findrow = .Range("B:B").Find(What:=sku, LookIn:=xlValues)
If Findrow Is Nothing Then
Rating1 = 0
Else
If Worksheets(month1).Cells(Findrow.Row, 17).Text = "D" Then
Rating1 = 1
Else
Rating1 = 0
End If
End If
End With


If Rating1 = 1 And Rating2 = 1 And Rating3 = 1 Then
Worksheets(month3).Cells(row1, 18) = "Remove"
Else
End If
Else
End If
Next x
Next xb
MsgBox ("Worksheets Updated")
End Sub

Forum Discussion

Matching the values in 3 months then paste the desired text at last month

Resources