VBA code required to replace the Index, Match and array formulas.

[Anbuselvam]

Hi

https://www.dropbox.com/s/yj6n2yn6cq3n5rf/Index Match_Batch Card.xlsx?dl=0

In the above link file, Sheet Batch Card A8 to F19 cells are shown results depends on D5 and F5 dropdown selection.

A8 to F19 results getting from Raw details stored on Sheet Formulation.

To get above results I have used index match and array formulas too.

Please provide the VBA code to eliminate all the formulas.

Sincerely Yours
Anbuselvam K

 

[DanteAmor]

Put the following code in the events of your sheet

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("D5:F5")) Is Nothing Then
        If Target.Count > 3 Then Exit Sub
        Range("A8:E19").Value = ""
        If Range("D5").Value = "" Or Range("F5").Value = "" Then Exit Sub
        '
        pName = Range("D5").Value
        nOrig = Range("F5").Value
        existe = False
        k = 8
        Set h = Sheets("Formulation")
        Set r = h.Columns("A")
        Set b = r.Find(pName, LookAt:=xlWhole, LookIn:=xlValues)
        If Not b Is Nothing Then
            celda = b.Address
            Do
                'detalle
                If LCase(h.Cells(b.Row, "B").Value) = LCase(nOrig) Then
                    existe = True
                    uc = h.Cells(4, Columns.Count).End(xlToLeft).Column
                    For j = 3 To uc
                        If h.Cells(b.Row, j).Value <> "" Then
                            Cells(k, "A").Value = h.Cells(4, j).Value
                            Cells(k, "B").Value = h.Cells(5, j).Value
                            Cells(k, "E").Value = h.Cells(b.Row, j).Value
                            k = k + 1
                        End If
                    Next
                    Exit Do
                End If
                Set b = r.FindNext(b)
            Loop While Not b Is Nothing And b.Address <> celda
        Else
            MsgBox "Prodcut not exists"
        End If
        If existe = False Then
            MsgBox "Relation Prodcut - Origin not exists"
        End If
    End If
End Sub

When you change the data of D5 or F5 the macro will be executed automatically

See link:

https://www.dropbox.com/s/eytv69ofoscwd9m/Index Match_Batch Card dam.xlsm?dl=0

 

[Anbuselvam]

Dear Dante Amor

Thanks, it is working good. Sorry for the delay in reply.

Put the following code in the events of your sheet

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("D5:F5")) Is Nothing Then
        If Target.Count > 3 Then Exit Sub
        Range("A8:E19").Value = ""
        If Range("D5").Value = "" Or Range("F5").Value = "" Then Exit Sub
        '
        pName = Range("D5").Value
        nOrig = Range("F5").Value
        existe = False
        k = 8
        Set h = Sheets("Formulation")
        Set r = h.Columns("A")
        Set b = r.Find(pName, LookAt:=xlWhole, LookIn:=xlValues)
        If Not b Is Nothing Then
            celda = b.Address
            Do
                'detalle
                If LCase(h.Cells(b.Row, "B").Value) = LCase(nOrig) Then
                    existe = True
                    uc = h.Cells(4, Columns.Count).End(xlToLeft).Column
                    For j = 3 To uc
                        If h.Cells(b.Row, j).Value <> "" Then
                            Cells(k, "A").Value = h.Cells(4, j).Value
                            Cells(k, "B").Value = h.Cells(5, j).Value
                            Cells(k, "E").Value = h.Cells(b.Row, j).Value
                            k = k + 1
                        End If
                    Next
                    Exit Do
                End If
                Set b = r.FindNext(b)
            Loop While Not b Is Nothing And b.Address <> celda
        Else
            MsgBox "Prodcut not exists"
        End If
        If existe = False Then
            MsgBox "Relation Prodcut - Origin not exists"
        End If
    End If
End Sub

When you change the data of D5 or F5 the macro will be executed automatically

See link:

https://www.dropbox.com/s/eytv69ofoscwd9m/Index Match_Batch Card dam.xlsm?dl=0

 

[Anbuselvam]

Dear Dante Amor

Actually, I posted model worksheet which was similar to my actual one, Becoz I have my company formulations in that.

Now the code provided by you is working good. But I don't know how to change as per my actual sheet.

I attached here the link of the actual sheet without data. Can you please change as per the below link

https://www.dropbox.com/s/x5nimiuz3mx9pli/Batch card New.xlsx?dl=0

Thanks in Advance.

 

[DanteAmor]

updated file
https://www.dropbox.com/s/4xxpms404c3gmhg/Batch card New dam.xlsm?dl=0

 

[Anbuselvam]

Dear Dante Amor

The provided sheet is looking at the values from C to I column in the sheet formulation. It has to take the values from Column C to BB.

https://www.dropbox.com/s/bpj4v4wb13kupku/Batch card New dam.xlsm?dl=0

Please check and modify the code.

 

[DanteAmor]

If you change the structure of the sheets, you must change the code.

The next time you try to make the change in the code, just check the logic of the lines. If you have doubts I will also help you.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("C4:F4")) Is Nothing Then
        If Target.Count > 3 Then Exit Sub
        Range("A7:E16").Value = ""
        pName = Range("C4").Value
        nOrig = Range("E4").Value
        If pName = "" Or nOrig = "" Then Exit Sub
        '
        existe = False
        k = 7
        Set h = Sheets("Formulation")
        Set r = h.Columns("A")
        Set b = r.Find(pName, LookAt:=xlWhole, LookIn:=xlValues)
        If Not b Is Nothing Then
            celda = b.Address
            Do
                'detalle
                If LCase(h.Cells(b.Row, "B").Value) = LCase(nOrig) Then
                    existe = True
                    uc = h.Cells(1, Columns.Count).End(xlToLeft).Column
                    For j = 3 To uc
                        If h.Cells(b.Row, j).Value <> "" Then
                            Cells(k, "A").Value = h.Cells(1, j).Value
                            Cells(k, "B").Value = h.Cells(3, j).Value
                            Cells(k, "E").Value = h.Cells(b.Row, j).Value
                            k = k + 1
                        End If
                    Next
                    Exit Do
                End If
                Set b = r.FindNext(b)
            Loop While Not b Is Nothing And b.Address <> celda
        Else
            MsgBox "Prodcut not exists"
        End If
        If existe = False Then
            MsgBox "Relation Prodcut - Origin not exists"
        End If
    End If
End Sub

https://www.dropbox.com/s/3qibal7668ualcz/Batch card New dam2.xlsm?dl=0

 

[Anbuselvam]

Dear Mr Dante Amor

I was trying to rewrite the codes according to my sheet changes But, I couldn't understand some of the lines in the codes. I mentioned those codes row number below for your comments. Could you please explain the mentioned lines what it does and where it is looking the data?

Line 3, If Target.Count > 3 Then Exit Sub (What is count 3 mean by)

Line 10, K = 7 (What is 7 mean by)

Line 15, celda = b.Address (What is Address)

Line 18 to 26 (Totally I did not Understand what it does)

If you are explaining the above lines, I can rewrite the code for my other requirements on my own.

Expecting your positive reply.

Thanks in advance.

If you change the structure of the sheets, you must change the code.

The next time you try to make the change in the code, just check the logic of the lines. If you have doubts I will also help you.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("C4:F4")) Is Nothing Then
        If Target.Count > 3 Then Exit Sub
        Range("A7:E16").Value = ""
        pName = Range("C4").Value
        nOrig = Range("E4").Value
        If pName = "" Or nOrig = "" Then Exit Sub
        '
        existe = False
        k = 7
        Set h = Sheets("Formulation")
        Set r = h.Columns("A")
        Set b = r.Find(pName, LookAt:=xlWhole, LookIn:=xlValues)
        If Not b Is Nothing Then
            celda = b.Address
            Do
                'detalle
                If LCase(h.Cells(b.Row, "B").Value) = LCase(nOrig) Then
                    existe = True
                    uc = h.Cells(1, Columns.Count).End(xlToLeft).Column
                    For j = 3 To uc
                        If h.Cells(b.Row, j).Value <> "" Then
                            Cells(k, "A").Value = h.Cells(1, j).Value
                            Cells(k, "B").Value = h.Cells(3, j).Value
                            Cells(k, "E").Value = h.Cells(b.Row, j).Value
                            k = k + 1
                        End If
                    Next
                    Exit Do
                End If
                Set b = r.FindNext(b)
            Loop While Not b Is Nothing And b.Address <> celda
        Else
            MsgBox "Prodcut not exists"
        End If
        If existe = False Then
            MsgBox "Relation Prodcut - Origin not exists"
        End If
    End If
End Sub

https://www.dropbox.com/s/3qibal7668ualcz/Batch card New dam2.xlsm?dl=0

 

[DanteAmor]

But I sent you the file with the updated code

 

[Anbuselvam]

Yes, your given sheet is working fine. But I want to understand the code lines which I mentioned in my previous post. I want to write another code for different requirements.

Hope you will help me to learn the VBA code.