Excel VBA Macro that can search and copy information of a table

[Espino2606]

Hey ! I Have been using Index and Match for solving this problem , however I think its making the sheet really slow
In simple terms I have a table in another sheet that works as a database , and in another sheet I use the information saved in there to do some calculations , I just want to know if there is a macro that helps me search that information
For example I want to look Charles Weight Number 1 and Number 2 , so the formula I used was , Index(Table1[Weight],Match(Cell where I put name and number,Table1[Name and Number]
Is there a macro that can help? or I just continue with the excel formula?

 

[mumps]

It is hard to work with a picture. It would be easier to help if you could use the XL2BB add-in (icon in the menu) to attach screenshots (not pictures) of your two 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).

 

[Espino2606]

I use the formula Index and Match to grab information from the table in sheet 2 , I do the search with the name and number , and then it searches for the column where the information I need is
If I need the weight of John of the second number , it looks where is John2 , and then search where the column of weight is (F) , and then match where is the weight (F7)
Is there a macro that can help me making this easier ? This is just an example , in reality I search for about 40 values
Test.xlsm

 

[mumps]

Copy and paste this macro into the worksheet code module. Do the following: right click the tab name for the sheet that will contain the information you use to do some calculations and click 'View Code'. Paste the macro into the empty code window that opens up. Close the code window to return to your sheet. Enter the name in cell C3 first and then enter the number in cell G3 and press the ENTER key.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.CountLarge > 1 Then Exit Sub
    If Intersect(Target, Range("G3")) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Dim val As String, fnd As Range
    val = Target.Offset(, -4) & Target
    Set fnd = Sheets("Sheet2").Range("I:I").Find(val, LookIn:=xlValues, lookat:=xlWhole)
    If Not fnd Is Nothing Then
        Range("C4") = fnd.Offset(, -4)
        Range("C6") = fnd.Offset(, -3)
        Range("C7") = fnd.Offset(, -2)
        Range("C9") = fnd.Offset(, -5)
        Range("J3") = val
    End If
    Application.ScreenUpdating = True
End Sub

 

[Espino2606]

It does work in the test sheet , however when I tried to understand the code and applied it in my work excel , it doesn't seem to work , it doesn't run
The only things I changed where
The G3 range
The Sheet Name
And where is val located

Copy and paste this macro into the worksheet code module. Do the following: right click the tab name for the sheet that will contain the information you use to do some calculations and click 'View Code'. Paste the macro into the empty code window that opens up. Close the code window to return to your sheet. Enter the name in cell C3 first and then enter the number in cell G3 and press the ENTER key.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.CountLarge > 1 Then Exit Sub
    If Intersect(Target, Range("G3")) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Dim val As String, fnd As Range
    val = Target.Offset(, -4) & Target
    Set fnd = Sheets("Sheet2").Range("I:I").Find(val, LookIn:=xlValues, lookat:=xlWhole)
    If Not fnd Is Nothing Then
        Range("C4") = fnd.Offset(, -4)
        Range("C6") = fnd.Offset(, -3)
        Range("C7") = fnd.Offset(, -2)
        Range("C9") = fnd.Offset(, -5)
        Range("J3") = val
    End If
    Application.ScreenUpdating = True
End Sub

 

[mumps]

A macro that works on sample data very often won’t work on actual data. Perhaps you could upload a copy of your file (de-sensitized if necessary) to a free file sharing site such as Dropbox.com or Box.com and post a link to the file here.

 

[Espino2606]

A macro that works on sample data very often won’t work on actual data. Perhaps you could upload a copy of your file (de-sensitized if necessary) to a free file sharing site such as Dropbox.com or Box.com and post a link to the file here.

Here is the original one with the columns and where every input is supposed to be
In Column AL it most show the data from the number (in cell Y4) associated with the name
In Column AM with number in cell Y5 , and so on

Excel Macro Online.xlsm

 

[mumps]

Copy and paste this macro into the worksheet code module. Do the following: right click the tab name for Sheet1 and click 'View Code'. Paste the macro into the empty code window that opens up. Close the code window to return to your sheet. Enter the name in cell Y3 first and then enter the number in any cell below row 3 and press the ENTER key.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.CountLarge > 1 Then Exit Sub
    If Intersect(Target, Range("Y4", Range("Y" & Rows.Count).End(xlUp))) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Dim val As String, fnd1 As Range, srcWS As Worksheet, lcol1 As Long, lcol2 As Long
    Set srcWS = Sheets("DataBase")
    lcol1 = srcWS.Cells(89, Columns.Count).End(xlToLeft).Column
    lcol2 = Cells(4, Columns.Count).End(xlToLeft).Column
    val = Range("Y2") & Target
    Set fnd1 = srcWS.Columns(lcol1).Find(val, LookIn:=xlValues, lookat:=xlWhole)
    If Not fnd1 Is Nothing Then
        Set fnd2 = Range("AL4").Resize(, lcol2 - 4).Find(Target.Value, LookIn:=xlValues, lookat:=xlWhole)
        If Not fnd2 Is Nothing Then
            Cells(5, fnd2.Column).Resize(lcol1 - 5).Value = Application.Transpose(srcWS.Range("E" & fnd1.Row).Resize(, lcol1 - 5))
        End If
    End If
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub