vlookup process via VBA taking more time for result

[riteshjain]

I am new in VBA, For finding values from multiple sheets (With sheet name) i have written code as follow, but it takes too much time to get out put in 8-9 cells in a one sheet.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim temp
Dim cs
Dim ts
Dim var1
'Target.Worksheets("Overview").Range("C8").Value
If Target.Address = "$C$8" Then


'Assign variables for Current Sheet, Target Sheet and search text
cs = ActiveSheet.Name
ts = "Overview"
var1 = Sheets(ts).Range("C8").Value
var2 = Sheets(ts).Range("C6").Value
var3 = Sheets(ts).Range("B9").Value
var4 = Sheets(ts).Range("B10").Value
var5 = Sheets(ts).Range("B11").Value
var6 = Sheets(ts).Range("B12").Value
var7 = Sheets(ts).Range("B13").Value
var8 = Sheets(ts).Range("B14").Value
var9 = Sheets(ts).Range("B15").Value
'Loop through all worksheets except listed
Application.ScreenUpdating = False
For Each wks In ActiveWorkbook.Worksheets
'Do this for all sheets except these
Select Case wks.Name
Case ts, "Input"
'do nothing with the above worksheets
Case Else

'With worksheets not listed, do the following...
With wks
Sheets(wks.Name).Activate

Set Source = ActiveSheet.Range("A6:AA4500")

For Each Row In Source

On Error Resume Next

If Row.Value = var1 Then
For Each Col In Source
If Col.Value = var2 Then

temp = Col.Column()
End If
Next Col
'Vlookup code a cell "C16" in Sheet1
Sheets(ts).Range("D16").Value = Application.WorksheetFunction.VLookup(var1, wks.Range("A6:AA4500"), temp, False)

End If
Next Row
'For component name
For Each Row In Source

On Error Resume Next

If Row.Value = var1 Then
For Each Col In Source
If Col.Value = var3 Then

temp = Col.Column()
End If
Next Col
'Vlookup code a cell "D9" in Sheet1
Sheets(ts).Range("D9").Value = Application.WorksheetFunction.VLookup(var1, wks.Range("A6:AA4500"), temp, False)

End If
Next Row
'For Drawing no.
For Each Row In Source

On Error Resume Next

If Row.Value = var1 Then
For Each Col In Source
If Col.Value = var4 Then

temp = Col.Column()
End If
Next Col
'Vlookup code a cell "D10" in Sheet1
Sheets(ts).Range("D10").Value = Application.WorksheetFunction.VLookup(var1, wks.Range("A6:AA4500"), temp, False)

End If
Next Row
'For Standard
For Each Row In Source

On Error Resume Next

If Row.Value = var1 Then
For Each Col In Source
If Col.Value = var5 Then

temp = Col.Column()
End If
Next Col
'Vlookup code a cell "D11" in Sheet1
Sheets(ts).Range("D11").Value = Application.WorksheetFunction.VLookup(var1, wks.Range("A6:AA4500"), temp, False)

End If
Next Row
'For DN
For Each Row In Source

On Error Resume Next

If Row.Value = var1 Then
For Each Col In Source
If Col.Value = var6 Then

temp = Col.Column()
End If
Next Col
'Vlookup code a cell "D11" in Sheet1
Sheets(ts).Range("D12").Value = Application.WorksheetFunction.VLookup(var1, wks.Range("A6:AA4500"), temp, False)

End If
Next Row
'For Dimension
For Each Row In Source

On Error Resume Next

If Row.Value = var1 Then
For Each Col In Source
If Col.Value = var7 Then

temp = Col.Column()
End If
Next Col
'Vlookup code a cell "D11" in Sheet1
Sheets(ts).Range("D13").Value = Application.WorksheetFunction.VLookup(var1, wks.Range("A6:AA4500"), temp, False)

End If
Next Row
'For SCH
For Each Row In Source

On Error Resume Next

If Row.Value = var1 Then
For Each Col In Source
If Col.Value = var8 Then

temp = Col.Column()
End If
Next Col
'Vlookup code a cell "D11" in Sheet1
Sheets(ts).Range("D14").Value = Application.WorksheetFunction.VLookup(var1, wks.Range("A6:AA4500"), temp, False)

End If
Next Row
'For material
For Each Row In Source

On Error Resume Next

If Row.Value = var1 Then
For Each Col In Source
If Col.Value = var9 Then

temp = Col.Column()
End If
Next Col
'Vlookup code a cell "D11" in Sheet1
Sheets(ts).Range("D15").Value = Application.WorksheetFunction.VLookup(var1, wks.Range("A6:AA4500"), temp, False)

End If
Next Row
End With
End Select

Next wks

Sheets(cs).Activate
End If
End Sub

 

[StephenCrump]

Welcome to the Forum!

Your code will be slow because you're looping through the same large range nine times. You're also not exiting your loops when you find the required values.

It should only be necessary to loop once at most, and looping code may not be required at all.

Can you please explain in more detail the layout of your workbook, and what you are trying to do with this code?

 

[riteshjain]

Thanks.........

Actually there are various machine parts category in 5 different sheets in a single workbook, every part has a unique Ident number.
The details of each parts for example its Material,Diameter,Length,Weight and cost are written in separate column with respective "column name".
now my purpose is when I write Ident number in Cell "C8" then all the above data for that Ident number should come in respective cells in a Overview sheet.
I have written the same column number in cells B9,B10,B11.......in overview sheet and when I run the code then respective values which was in another sheet will get printed in cells D9,D10,D11.......in overview sheet
Please tell me if you require more details...

 

[StephenCrump]

There are different ways you could do this. One way would be to combine your five category sheets into a single sheet, with a column identifying the category. That way you could filter, and still view the parts for a single category if you wished.

Assuming you want to maintain five different sheets, and that you don't have an index identifying which category a particular part belongs to, then one way forward would be to use a simple UDF to identify the category/sheet as follows:

Function GetSheetName(sIDNo As String) As Variant

    Dim ws As Worksheet
    Dim lRow As Long
    Const COLUMN_NO = 1     'Assumes Part IDs in column A
    
    GetSheetName = CVErr(xlErrNA)
    
    For Each ws In Worksheets(Array("Cat 1", "Cat 2", "Cat 3", "Cat 4", "Cat 5"))
        On Error Resume Next
        'Assumes Part IDs in column A
        lRow = ws.Columns(COLUMN_NO).Find(what:=sIDNo, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False).Row
        On Error GoTo 0
        If lRow <> 0 Then
            GetSheetName = ws.Name
            Exit For
        End If
    Next ws
    
End Function

You could then use Excel and the INDIRECT() function to look up the part details on the appropriate sheet.

Alternatively, we could expand the VBA to "hard-code" the formulae based on the sheet names for each part number. This would mean that for Part# ABC-123, the Excel formula might point to Sheets("Cat 3"), whereas for Part# DEF-456, the Excel formula might point to Sheets("Cat 4").