Macro or formula to change cell value IF two cells from different sheets matches AND a specific cell text

[strangerobot]

Sheet 1 Sheet 2

I am trying to do the following but I can't seem to work it out:

Sheet1 is my inventory, Sheet2 is supplier's inventory. We'll use SKU "AAA" as an example.

If Sheet2's SKU (A2) equals to Status "Out of Stock" (C2), match with Sheet1's SKU (E3) and change Quantity (D3) to "0"

In this case I will need SKU AAA, DDD and EEE's quantity to change to 0 in Sheet1.

What is the best formula for this if I have hundreds of SKU rows that needs to run daily? Is it possible to automate this using a macro?

Forgive me if the question is silly as I am very new to this, hopefully someone can shed some light and point me towards the right direction. Thank you!

 

[mumps]

Try:

Sub MatchData()
    Application.ScreenUpdating = False
    Dim desWS As Worksheet, srcWS As Worksheet, arr1 As Variant, arr2 As Variant, Val As String, dic As Object
    Set srcWS = Sheets("Sheet2")
    Set desWS = Sheets("Sheet1")
    Dim LastRow As Long
    arr2 = srcWS.Range("A2", srcWS.Range("A" & Rows.Count).End(xlUp)).Resize(, 3).Value
    arr1 = desWS.Range("E2", desWS.Range("E" & Rows.Count).End(xlUp)).Value
    Set dic = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(arr1, 1)
        Val = arr1(i, 1)
        If Not dic.Exists(Val) Then
            dic.Add Key:=Val, Item:=i + 1
        End If
    Next i
    For i = 1 To UBound(arr2, 1)
        Val = arr2(i, 1)
        If dic.Exists(Val) Then
            If arr2(i, 3) = "Out of Stock" Then
                desWS.Range("D" & dic(Val)) = 0
            End If
        End If
    Next i
    Application.ScreenUpdating = True
End Sub

 

[strangerobot]

Sorry for the late response. I had to quickly go through a few intro to VBA tutorials to make sense of the code and voila!! It works perfectly! Thank you so much for this, very much appreciated.

 

[mumps]

You are very welcome.

 

[strangerobot]

Try:

Sub MatchData()
    Application.ScreenUpdating = False
    Dim desWS As Worksheet, srcWS As Worksheet, arr1 As Variant, arr2 As Variant, Val As String, dic As Object
    Set srcWS = Sheets("Sheet2")
    Set desWS = Sheets("Sheet1")
    Dim LastRow As Long
    arr2 = srcWS.Range("A2", srcWS.Range("A" & Rows.Count).End(xlUp)).Resize(, 3).Value
    arr1 = desWS.Range("E2", desWS.Range("E" & Rows.Count).End(xlUp)).Value
    Set dic = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(arr1, 1)
        Val = arr1(i, 1)
        If Not dic.Exists(Val) Then
            dic.Add Key:=Val, Item:=i + 1
        End If
    Next i
    For i = 1 To UBound(arr2, 1)
        Val = arr2(i, 1)
        If dic.Exists(Val) Then
            If arr2(i, 3) = "Out of Stock" Then
                desWS.Range("D" & dic(Val)) = 0
            End If
        End If
    Next i
    Application.ScreenUpdating = True
End Sub

Hi mumps, so I want to say your code worked beautifully. However now I am trying to repurpose the code to perform another function:

- Match the SKUs like your code did
- If there is a match, update Sheet1's price based on Sheet2's price (let's say in column D) following a formula, in this case it will be a percentage number in Sheet3's A2. I am trying to get Sheet2's D2 to increase by Sheet3's A2 percentage equals to Sheet1's B2.

Here is my amateur attempt below at modifying your code to do the above but it will probably be clear to you why it is failing, are you able to point out where I am going wrong? Thank you kindly!!

Sub MatchData_Price()
    Application.ScreenUpdating = False
    Dim desWS As Worksheet, srcWS As Worksheet, forWS as Worksheet, arr1 As Variant, arr2 As Variant, Val As String, dic As Object

    Set srcWS = Sheets("Sheet2")
    Set desWS = Sheets("Sheet1")
    Set forWS = Sheets("Sheet3")

    Dim LastRow As Long
    arr2 = srcWS.Range("A2", srcWS.Range("A" & Rows.Count).End(xlUp)).Resize(, 3).Value
    arr1 = desWS.Range("E2", desWS.Range("E" & Rows.Count).End(xlUp)).Value
    Set dic = CreateObject("Scripting.Dictionary")

    For i = 1 To UBound(arr1, 1)
        Val = arr1(i, 1)
        If Not dic.Exists(Val) Then
            dic.Add Key:=Val, Item:=i + 1
        End If
    Next i

    For i = 1 To UBound(arr2, 1)
        Val = arr2(i, 1)
        If dic.Exists(Val) Then

                desWS.Range("B" & dic(Val)) = Application.Sum(arr2(i, 4) * forWS.Range("A2").Value)

            End If
        End If
    Next i

    Application.ScreenUpdating = True
End Sub

 

[Dossfm0q]

Greetings
From my Side You have Little pit error
arr2 = srcWS.Range("A2", srcWS.Range("A" & Rows.Count).End(xlUp)).Resize(, 3).Value' to be 4 or above if "desWS.Range("B" & dic(Val)) = Application.Sum(arr2(i, 4) "

with
desWS.Range("B" & dic(Val)) = Application.Sum(arr2(i, 4) * forWS.Range("A2").Value) ' ' 4 to be less than or equal 3 if " .Resize(, 3).Value is 3"


duplicate " End If "
If dic.Exists(Val) Then

desWS.Range("B" & dic(Val)) = Application.Sum(arr2(i, 4) * forWS.Range("A2").Value)

Sub MatchData_Price()
    Application.ScreenUpdating = False
    Dim desWS As Worksheet, srcWS As Worksheet, forWS As Worksheet, arr1 As Variant, arr2 As Variant, Val As String, dic As Object

    Set srcWS = Sheets("Sheet2")
    Set desWS = Sheets("Sheet1")
    Set forWS = Sheets("Sheet3")

    Dim LastRow As Long
    arr2 = srcWS.Range("A2", srcWS.Range("A" & Rows.Count).End(xlUp)).Resize(, 3).Value ' .Resize(, 4).Value
    arr1 = desWS.Range("E2", desWS.Range("E" & Rows.Count).End(xlUp)).Value
    Set dic = CreateObject("Scripting.Dictionary")

    For i = 1 To UBound(arr1, 1)
        Val = arr1(i, 1)
        If Not dic.Exists(Val) Then
            dic.Add Key:=Val, Item:=i + 1
        End If
    Next i

    For i = 1 To UBound(arr2, 1)
        Val = arr2(i, 1)
        If dic.Exists(Val) Then
                'Sum(arr2(i, 4)' XX
                desWS.Range("B" & dic(Val)) = Application.Sum(arr2(i, 3) * forWS.Range("A2").Value)

            'End If
        End If
    Next i

    Application.ScreenUpdating = True
End Sub

' End If
End If

 

[mumps]

It would be easier to help if you could use the XL2BB add-in (icon in the menu) to attach a screenshot (not a picture) of your 3 sheets. Alternately, you could upload a copy of your file to a free site such as www.box.com or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. Explain in detail what you want to do referring to specific cells, rows, columns and sheets using a few examples from your data (de-sensitized if necessary).