Forum Discussion

Improving's avatar
Improving
Copper Contributor
Dec 11, 2020
Solved

Col “B” values should be match with Three months

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

 

  • Improving I still don't understand some of what you are doing and why so still hesitant to change too much but here is a simplified version of the macro that I believe gives correct results.  NOTE that 2 cases appear to be wrong based on your VLOOKUP but your VLOOKUP doesn't extend to the bottom on the Oct 2020 page.

    Sub Matching2()
    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
                If MatchFound(month2, sku, "D") And MatchFound(month1, sku, "D") Then
                    Worksheets(month3).Cells(x, 18) = "Remove"
                Else
                End If
            Else
            End If
        Next x
    Next xb
    MsgBox ("Worksheets Updated")
    End Sub
    
    Function MatchFound(shtname, sku, val) As Boolean
       MatchFound = (Worksheets(shtname).Range("b:b").Find(What:=sku, LookIn:=xlValues).Offset(0, 15) = val)
    End Function

9 Replies

  • mtarler's avatar
    mtarler
    Silver Contributor

    Improving There are a number of things I don't get why you are doing it this way and think this whole thing could be much more efficient but I also really don't know what you are expecting/needing on the output. Although there a number of things I would love to ask/challenge I will keep it only to where I THINK your problem might be:

    a)  In this segment of code I believe you have a typo on your variable name:

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

    I think you meant to have Rating2 = 0 on this line

     

    b)   In ALL cases you don't reinitialize the RATING variable and rely on it falling into 1 of the conditions where it is set. 
    For Rating3 I think it will always be 1 because I can't see how it will not find itself and even if it is on the page 2x (i.e. you find it on a row that isn't "D") you don't have a condition/set to change the value of Rating3 and as I mentioned you don't re-initialize it either.

    For Rating2 i believe you are missing a condition/set.  In the Month1 & 2 sections you have this segment of code EXCEPT the bold section is missing from Month2 code:

         If Worksheets(month1).Cells(Findrow.Row, 17).Text = "D" Then
              Rating1 = 1
         Else

              Rating1 = 0
         End If

     

    • Improving's avatar
      Improving
      Copper Contributor
      I am really thankful that you give me that huge help after understanding it completely.

      Thank you so much.
      Thank you once again Sir.
    • mtarler's avatar
      mtarler
      Silver Contributor

      Improving I still don't understand some of what you are doing and why so still hesitant to change too much but here is a simplified version of the macro that I believe gives correct results.  NOTE that 2 cases appear to be wrong based on your VLOOKUP but your VLOOKUP doesn't extend to the bottom on the Oct 2020 page.

      Sub Matching2()
      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
                  If MatchFound(month2, sku, "D") And MatchFound(month1, sku, "D") Then
                      Worksheets(month3).Cells(x, 18) = "Remove"
                  Else
                  End If
              Else
              End If
          Next x
      Next xb
      MsgBox ("Worksheets Updated")
      End Sub
      
      Function MatchFound(shtname, sku, val) As Boolean
         MatchFound = (Worksheets(shtname).Range("b:b").Find(What:=sku, LookIn:=xlValues).Offset(0, 15) = val)
      End Function
      • Improving's avatar
        Improving
        Copper Contributor

        mtarler Hi, sir, 

         

        I have been using your code where an error is occurred when it is applied to other sheets.

         

        Error is Object variable or With block variable not set

Resources