VBA Advanced - Matching duplicates

[mickeystanford_alumni]

Hi everyone,
First of all, thank you very much in advance for your help.

I have a task where I need to consolidate 2 sheets (actually there are more but knowing the format of 1, I will manage to get the rest).
- Table 1 is the first sheet where I get data from companies and the quantities they sell from different origins and destinations. As you can see there are 3 companies (a,b,c) with a quantity and a name allocated.
- Table 2 is let's say a better and more updated version of sheet 1. Here, I have the breakdown of products (type, number, origin, destination), while as you can see in table 1 I only have like a consolidated estimation of where the sales are produced and where they go. However, as we can see, then we see that table 2 explicitly tells you quantity, type and destination.

What I have to do is to merge both tables with a format where I say:
FIRST
=if in table 1 and if in table 2, leave table 2 rows and delete table 1 (so there are no duplicates). Therefore, as we can see for company A we would have the first three rows. A parenthesis here, in row 3 of company A we see the type is sports+merchandising, so I would like to tell excel to say if sports+merchandising, duplicate the row with the quantity of sports, and the quantity of merchandising, so it would look like:
COMPANY NAME QUANTITY PRODUCT 1(SPORTS) PRODUCT 2(MACHINERY) PRODUCT 3(MERCHADISING) TYPE ORIGIN DESTINATION
A AA 30000 5000 MEXICO CHINA
A AA 30000 5000 MEXICO CHINA

SECOND
=if in table 1, but not in table 2, then keep table 1 (and put the name in RED so I have the alert)

THIRD
=if in table 2, but not in table 1, then keep table 2 (and put the name in RED so I have the alert)

I am struggling badly with this, so I would really appreciate your help.
Happy to clarify any doubts if arise and hope it is clear


TABLE 1

COMPANY	NAME	QUANTITY	PRODUCT TYPE	ORIGIN	DESTINATION
A	AA	30000​		USA+MEXICO	EUROPE
B	BB	20000​		USA+MEXICO	CHINA
C	CC	15000​		USA	RUSSIA

TABLE 2

COMPANY	NAME	QUANTITY	PRODUCT 1 (SPORTS)	PRODUCT 2 (MACHINERY)	PRODUCT 3 (MERCHANDISING)	TYPE	ORIGIN	DESTINATION
A	AA	30000​	10000​			SPORTS	USA	EUROPE
A	AA	30000​	10000​			SPORTS	USA	EUROPE
A	AA	30000​	5000​		5000​	SPORTS+MERCHANDISING	MEXICO	CHINA
B	BB	20000​	10000​			SPORTS	USA	CHINA
B	BB	20000​			10000​	MERCHANDISING	USA	RUSSIA
D	DD	10000​	10000​			SPORTS	USA	EUROPE

 

[Coding4Fun]

Give this a shot.

Sub Test()

Dim WS5 As Worksheet
Set WS5 = Sheets("Sheet5")

Dim WS6 As Worksheet
Set WS6 = Sheets("Sheet6")

'Check how many rows of data we have in Table 1 - This is assumed to be in Sheet5 change accordingly
MyLastRow = WS5.Cells(Rows.Count, 1).End(xlUp).Row

'Check how many rows of data we have in Table 2 - This is assumed to be in Sheet6 change accordingly
MyLastRow2 = WS6.Cells(Rows.Count, 1).End(xlUp).Row

'First we will loop through Table 1
'Checking  for any values in Table 1 not in Table 2
For i = 2 To MyLastRow

    Val1 = WS5.Range("A" & i).Value

    For n = 2 To MyLastRow2

        If Val1 = WS6.Range("A" & n).Value Then
            Found = True
            Exit For
        Else
            Found = False
        End If

    Next n
    
    If Found = False Then
    
        With WS5.Range("A" & i & ":F" & i)
            .Cells.Interior.Color = RGB(255, 0, 0)
        End With
    
    End If

Next i

For E = 2 To MyLastRow2

    Val3 = WS6.Range("A" & E).Value
    
    For g = 2 To MyLastRow
    
        If Val3 = WS5.Range("A" & g).Value Then
            Found = True
            Exit For
        Else
            Found = False
        End If
    
    Next g
    
        If Found = False Then
    
            With WS6.Range("A" & E & ":I" & E)
                .Cells.Interior.Color = RGB(255, 0, 0)
            End With
    
        End If

Next E

For r = 2 To MyLastRow2

spl = False
    If WS6.Range("G" & r).Value Like "*+*" Then
        Count = Len(WS6.Range("G" & r).Value) - Len(Replace(WS6.Range("G" & r).Value, "+", ""))
        If Count = 1 Then
            Rows(r + 1).Insert Shift:=xlDown
            Rows(r + 1).FillDown
            spl = True
            MyLastRow2 = MyLastRow2 + 1
        End If
        If Count = 2 Then
            Rows(r + 1).Insert Shift:=xlDown
            Rows(r + 1).Insert Shift:=xlDown
            Rows(r + 1).FillDown
            Rows(r + 2).FillDown
            spl = True
            MyLastRow2 = MyLastRow2 + 2
        End If
    End If
    
    If WS6.Range("G" & r).Value Like "*SPORTS*" And spl = True Then
        
        If Count = 1 Then
            Range("D" & r + 1).Clear
            Inc = 1
        ElseIf Count = 2 Then
            Range("D" & r + 1 & ":D" & r + 2).Clear
            Inc = 2
        End If
        
    End If
    
    If WS6.Range("G" & r).Value Like "*MACHINERY*" And spl = True Then
        
        If Count = 1 Then
            Range("E" & r).Clear
            Inc = 1
        ElseIf Count = 2 Then
            Range("E" & r).Clear
            Range("E" & r + 2).Clear
            Inc = 2
        End If
        
    End If
    
    If WS6.Range("G" & r).Value Like "*MERCHANDISING*" And spl = True Then
        
        If Count = 1 Then
            Range("F" & r).Clear
            Inc = 1
        ElseIf Count = 2 Then
            Range("F" & r).Clear
            Range("F" & r + 1).Clear
            Inc = 2
        End If
        
    End If
    
    If Inc = 1 Then
    r = r + 1
    End If

    If Inc = 2 Then
    r = r + 2
    End If

Next r

End Sub

 

[mickeystanford_alumni]

Wow, this was stunning. Really much appreciate your effort mate. Amazing.

If I can ask 2 more things, would there be any way to tell "Sheet 6", copy paste the red rows of "Sheet 5"?

So, if I have it in "Sheet 5" and not in "Sheet 6", it turned red in "Sheet 5", then copy paste those values to "Sheet 6", so then I have the full consolidation in "Sheet 6". Might be easier to put different colors, I don't mind about that (like yellow the ones of sheet 5 and red the ones of sheet 6, and then consolidate those in sheet 5.

Second question, is there any way to tell excel as well: for company A where we had Sports+Merchandising and we splitted both as 5000 sports, 5000 merchandising, to split as well the type? So in the row where we have the qty 5000 sports then the type (column G) we leave it as only sports, and same for the merchandising one.

Again, thank you so much for your support. Really appreciate.

 

[Coding4Fun]

Give this a shot.

Sub Test()

Dim WS5 As Worksheet
Set WS5 = Sheets("Sheet5")

Dim WS6 As Worksheet
Set WS6 = Sheets("Sheet6")

'Check how many rows of data we have in Table 1 - This is assumed to be in Sheet5 change accordingly
myLastRow = WS5.Cells(Rows.Count, 1).End(xlUp).Row

'Check how many rows of data we have in Table 2 - This is assumed to be in Sheet6 change accordingly
myLastRow2 = WS6.Cells(Rows.Count, 1).End(xlUp).Row

'First we will loop through Table 1
'Checking  for any values in Table 1 not in Table 2
For i = 2 To myLastRow

    Val1 = WS5.Range("A" & i).Value

    For n = 2 To myLastRow2

        If Val1 = WS6.Range("A" & n).Value Then
            Found = True
            Exit For
        Else
            Found = False
        End If

    Next n
    
    If Found = False Then
    
        With WS5.Range("A" & i & ":F" & i)
            .Cells.Interior.Color = RGB(255, 0, 0)
        End With
        
        WS6.Range("A" & myLastRow2 + 1 & ":C" & myLastRow2 + 1).Value = WS5.Range("A" & i & ":C" & i).Value
        WS6.Range("H" & myLastRow2 + 1 & ":I" & myLastRow2 + 1).Value = WS5.Range("E" & i & ":F" & i).Value
        myLastRow2 = myLastRow2 + 1
        
        With WS6.Range("A" & myLastRow2 & ":I" & myLastRow2)
            .Cells.Interior.Color = RGB(255, 255, 0)
        End With
    End If

Next i

For e = 2 To myLastRow2

    Val3 = WS6.Range("A" & e).Value
    
    For g = 2 To myLastRow
    
        If Val3 = WS5.Range("A" & g).Value Then
            Found = True
            Exit For
        Else
            Found = False
        End If
    
    Next g
    
        If Found = False Then
    
            With WS6.Range("A" & e & ":I" & e)
                .Cells.Interior.Color = RGB(255, 0, 0)
            End With
    
        End If

Next e

For r = 2 To myLastRow2

spl = False
    If WS6.Range("G" & r).Value Like "*+*" Then
        Count = Len(WS6.Range("G" & r).Value) - Len(Replace(WS6.Range("G" & r).Value, "+", ""))
        If Count = 1 Then
            Rows(r + 1).Insert Shift:=xlDown
            Rows(r + 1).FillDown
            spl = True
            myLastRow2 = myLastRow2 + 1
        End If
        If Count = 2 Then
            Rows(r + 1).Insert Shift:=xlDown
            Rows(r + 1).Insert Shift:=xlDown
            Rows(r + 1).FillDown
            Rows(r + 2).FillDown
            spl = True
            myLastRow2 = myLastRow2 + 2
        End If
    End If
    
    If WS6.Range("G" & r).Value = "SPORTS+MERCHANDISING" Or WS6.Range("G" & r).Value = "MERCHANDISING+SPORTS" And spl = True Then
        Range("G" & r).Value = "SPORTS"
        Range("G" & r + 1).Value = "MERCHANDISING"
        Range("D" & r + 1).Clear
        Range("F" & r).Clear
        Inc = 1
    End If
    
    If WS6.Range("G" & r).Value = "SPORTS+MACHINERY" Or WS6.Range("G" & r).Value = "MACHINERY+SPORTS" And spl = True Then
        Range("G" & r).Value = "SPORTS"
        Range("G" & r + 1).Value = "MACHINERY"
        Range("D" & r + 1).Clear
        Range("E" & r).Clear
        Inc = 1
    End If

    If WS6.Range("G" & r).Value = "SPORTS+MERCHANDISING+MACHINERY" Or WS6.Range("G" & r).Value = "SPORTS+MACHINERY+MERCHANDISING" Or WS6.Range("G" & r).Value = "MERCHANDISING+SPORTS+MACHINERY" Or WS6.Range("G" & r).Value = "MERCHANDISING+MACHINERY+SPORTS" Or WS6.Range("G" & r).Value = "MACHINERY+SPORTS+MERCHANDISING" Or WS6.Range("G" & r).Value = "MACHINERY+MERCHANDISING+SPORTS" And spl = True Then
        Range("G" & r).Value = "SPORTS"
        Range("G" & r + 1).Value = "MACHINERY"
        Range("G" & r + 2).Value = "MERCHANDISING"
        Range("D" & r + 1).Clear
        Range("D" & r + 2).Clear
        Range("E" & r).Clear
        Range("E" & r + 2).Clear
        Range("F" & r).Clear
        Range("F" & r + 1).Clear
        Inc = 2
    End If

    If WS6.Range("G" & r).Value = "MERCHANDISING+MACHINERY" Or WS6.Range("G" & r).Value = "MACHINERY+MERCHANDISING" And spl = True Then
        Range("G" & r).Value = "MACHINERY"
        Range("G" & r + 1).Value = "MERCHANDISING"
        Range("E" & r + 1).Clear
        Range("F" & r).Clear
        Inc = 1
    End If
  
    If Inc = 1 Then
    r = r + 1
    End If

    If Inc = 2 Then
    r = r + 2
    End If

Next r

End Sub