ADVANCED - Having issues with conditional statements

[mickeystanford_alumni]

Dear guys,

Hope you are good.

I want to convert some data with a few conditions. My tables are below. Table 1 is how I have the data. Table 2 is how I want the data to look like (adding a few conditions).

Basically, I want to first split the row and duplicate if the Origin has two countries. I created this code, however, I would like the origin to also be splitted. If Row1, USA+Mexico; Row2, USA; ROW3, Mexico.
Count = Len(WS6.Range("E" & R).Value) - Len(Replace(WS6.Range("E" & R).Value, "+", ""))
If Count = 1 Then
Rows(R + 1).Insert Shift:=xlDown
Rows(R + 1).FillDown
spl = True
MyLastRow2 = MyLastRow2 + 1

Then, once I have the rows splitted, I want to tell excel to apply some conditions.
1. If origin has 2 countries (no matter what country), then give to USA, 2,500 of the sales and the rest of sales to Mexico. I always have in the origin USA+Mexico, so that might be easier for the code. Although the quantity changes.

2. For this quantity change then I want to apply:
2.1. If the rest of sales is lower than 800, then 60% of the times put 0, and 40% of the times put the rest of sales.
2.2. If the rest of sales is between 800 and 1200, 30% of the times put 0, and 70% of the times put rest of sales.
2.3. If the rest of sales is higher than 1,200, then 100% of the times put rest of sales.

TABLES

COMPANY	SALES QUANTITY	ORIGIN	DESTINATION
APPLE	4,000	USA+MEXICO	EUOROPE

DESIRED OUTCOME

COMPANY	SALES QUANTITY	ORIGIN	DESTINATION
APPLE	2,500	USA	EUROPE
APPLE	1,500	MEXICO	EUROPE

THANK YOU.

 

[Coding4Fun]

Basically, I want to first split the row and duplicate if the Origin has two countries. I created this code, however, I would like the origin to also be splitted. If Row1, USA+Mexico; Row2, USA; ROW3, Mexico.

Assuming this is expanding on the code "I" provided...

If you can clarify what you mean by point 2.1 and 2.2 in regards to 60%/40% and 30%/70%

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
    
    [COLOR=rgb(226, 80, 65)]If WS5.Range("E" & i).Value = "USA+MEXICO" Then
        Rows(i + 1).Insert Shift:=xlDown
        Rows(i + 1).FillDown
        WS5.Range("E" & i).Value = "USA"
        WS5.Range("E" & i + 1).Value = "MEXICO"
        
        Qty = WS5.Range("C" & i).Value
        
        If Qty >= 2500 Then
            WS5.Range("C" & i).Value = 2500
            QtyRem = Qty - 2500
            If QtyRem > 1200 Then
            WS5.Range("C" & i + 1).Value = QtyRem
            ElseIf QtyRem < 1200 And QtyRem > 800 Then
            WS5.Range("C" & i + 1).Value = QtyRem
            Else
            WS5.Range("C" & i + 1).Value = QtyRem
            End If
        Else
            WS5.Range("C" & i).Value = Qty
            WS5.Range("C" & i + 1).Value = 0
        End If
        myLastRow = myLastRow + 1
        i = i + 1
    End If[/COLOR]

    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

 

[mickeystanford_alumni]

Assuming this is expanding on the code "I" provided...

If you can clarify what you mean by point 2.1 and 2.2 in regards to 60%/40% and 30%/70%

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
   
    [COLOR=rgb(226, 80, 65)]If WS5.Range("E" & i).Value = "USA+MEXICO" Then
        Rows(i + 1).Insert Shift:=xlDown
        Rows(i + 1).FillDown
        WS5.Range("E" & i).Value = "USA"
        WS5.Range("E" & i + 1).Value = "MEXICO"
       
        Qty = WS5.Range("C" & i).Value
       
        If Qty >= 2500 Then
            WS5.Range("C" & i).Value = 2500
            QtyRem = Qty - 2500
            If QtyRem > 1200 Then
            WS5.Range("C" & i + 1).Value = QtyRem
            ElseIf QtyRem < 1200 And QtyRem > 800 Then
            WS5.Range("C" & i + 1).Value = QtyRem
            Else
            WS5.Range("C" & i + 1).Value = QtyRem
            End If
        Else
            WS5.Range("C" & i).Value = Qty
            WS5.Range("C" & i + 1).Value = 0
        End If
        myLastRow = myLastRow + 1
        i = i + 1
    End If[/COLOR]

    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

Incredible your help. Really appreciate it. Worked perfectly!!
THANKS