VBA: Index match multiple criteria & autofill until last row with Column as ref

**Carim** · Sep 17th 2019

Hello,

It would seem from your private message ... that you do keep on modifying your worksheets' structures ...

Please attach the very last version 5 to your next message ...

Billy_Kisuke · Sep 18th 2019

Quote from Carim

Hello,

It would seem from your private message ... that you do keep on modifying your worksheets' structures ...

Please attach the very last version 5 to your next message ...

Hi Carim,

Thanks for your response.

Regret for inconvenience caused.

I have uploaded V5 for your ready reference, requesting you to provide the solution.

Thanks in advance again for your time & support.

- Billy

**Carim** · Sep 18th 2019

Hello,

Attached is your last TURBO version... which deserves the V6 attribute ... !!!

Hope this will solve all issues

Billy_Kisuke · Sep 18th 2019

Quote from Carim

Hello,

Attached is your last TURBO version... which deserves the V6 attribute ... !!! :smile:

Hope this will solve all issues

Hi Carim,

I am speechless to express my gratitude. Your code is magic working the way I wanted it for.

Thanks a lot, I really owe you greatly.

- Billy

**Carim** · Sep 18th 2019

Glad to hear you have finalized your project ...

Thanks a lot ... for both your Thanks AND for the Like ...

rehan kazi · Mar 26th 2021

Hi Carim,

Your code is working fine. I have modified it to suit my requirement. However, I want to run this code by clicking on the cell instead of the button. I'm trying to link this code to another VBA that runs after clicking on the cell.

Code

Option Explicit

Sub Results()
'Produce Results for Columns E,F,G,H,I
Dim c As Range
Dim rng As Range
Dim last1 As Long, last2 As Long
Dim i As Long, col As Long

last1 = Sheets("RetrievalReport").Cells(Rows.Count, "N").End(xlUp).Row
last2 = Sheets("Display").Cells(Rows.Count, "D").End(xlUp).Row
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
For col = 31 To 32
Set rng = Sheets("Display").Range(Cells(2, col), Cells(last2, col))
For Each c In rng
i = c.Row
c = Evaluate("=INDEX(RetrievalReport!" & Col_Letter(col - 18) & "1:" & Col_Letter(col - 18) & last1 & ",MATCH(D" & i & "&B1" & "&C1" & "&D1" & ",RetrievalReport!N1:N" & last1 & "&RetrievalReport!C1:C" & last1 & "&RetrievalReport!D1:D" & last1 & "&RetrievalReport!E1:E" & last1 & ",0))")
c = IIf(IsError(c), "", c)
Next c
Next col
col = 33
Set rng = Sheets("Display").Range(Cells(2, col), Cells(last2, col))
For Each c In rng
i = c.Row
c = Evaluate("=INDEX(RetrievalReport!" & Col_Letter(col - 15) & "1:" & Col_Letter(col - 15) & last1 & ",MATCH(D" & i & "&B1" & "&C1" & "&D1" & ",RetrievalReport!N1:N" & last1 & "&RetrievalReport!C1:C" & last1 & "&RetrievalReport!D1:D" & last1 & "&RetrievalReport!E1:E" & last1 & ",0))")
c = IIf(IsError(c), "", c)
Next c
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

Function Col_Letter(lngCol As Long) As String
Dim vArr
vArr = Split(Cells(1, lngCol).Address(True, False), "$")
Col_Letter = vArr(0)
End Function

Display More

**Carim** · Mar 26th 2021

Hello,

Are you saying the macro you have modified is producing the results you are expecting ...?

It seems to be the case ...

So your question is how to run this macro from a double-click event macro ...

Below is an example you will need to adapt to your specific situation ...

Code

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
' Modify the Address of the Cell you want to use ...
If Target.Address <> "$A$1" Then Exit Sub
Application.Run ("Results")
Cancel = True
End Sub

Do not forget an Event macro is to be stored in the worksheet module ...

Hope this will help

**Carim** · Mar 26th 2021

OK ...

The Forum rules are calling for you to create your own thread ... a brand new thread ...

When creating your thread ... please remember two things :

1. Attach a sample file

and if you want to post a macro ...

2. Use Code Tags </>

Will delete your Message # 28 ...

rehan kazi · Mar 26th 2021

Code

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)

 
   Sheets("Display").Rows("6:" & Sheets("Display").Rows.Count).Clear
   
   
'''''''''''''''''''''Sheets("Display").Range("A5:Z50").ClearContents
 ''''''''''''''Range(Range("A20"), Cells(Rows.Count, Columns.Count)).ClearContents
 
   Application.EnableEvents = False
  If Target.Cells.Count = 1 Then
    If Not Intersect(Target, Range("D5:D130")) Is Nothing Then
    Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(0, -1)).Select
     Selection.Copy Destination:=Sheets("Display").Range("B2")
     
      With Selection
  .Copy
   Sheets("Display").Range("B2").PasteSpecial xlPasteValues
 End With

      
     ''''' 'Sheets("Sheet2").Columns(2).PasteSpecial xlPasteValues
  
   
        Sheets("Display").Activate
  
  
          ElseIf Not Intersect(Target, Range("E5:E130")) Is Nothing Then
    Range(ActiveCell, ActiveCell.Offset(0, -2)).Select
      Selection.Copy Destination:=Sheets("Display").Range("B2")
     
    
     Sheets("Display").Activate
   
     End If
      End If
      
    
 
    Application.EnableEvents = True
  
     Worksheets("Lab Report").Range("A5").AutoFilter Field:=3, Criteria1:=Worksheets("Display").Range("B2")
    Worksheets("Lab Report").Range("A5").AutoFilter Field:=4, Criteria1:=Worksheets("Display").Range("C2")
    Worksheets("Lab Report").Range("A5").AutoFilter Field:=5, Criteria1:=Worksheets("Display").Range("D2")
  'Worksheets("Lab Report").Range("A5").AutoFilter Field:=7, Criteria1:=Worksheets("Display").Range("E2") & "" & variable & "*"  '''''(search starting word of Cell Value)
       
  '''''Worksheets("Lab Report").Range("A5").AutoFilter Field:=8, Criteria1:=Worksheets("Display").Range("E2")
  
 '''''Worksheets("Lab Report").Range("A5").AutoFilter Field:=7, Criteria1:=Worksheets("Display").Range("D2").Value = Split(Range("D2").Value, "*")(0)
      If Worksheets("Lab Report").Range("A5:A100").SpecialCells(xlCellTypeVisible).Count > 1 Then
      
  
      
       Worksheets("Lab Report").Range("I6:I500").Copy Destination:=Worksheets("Display").Range("D6")
       Worksheets("Lab Report").Range("O6:AN500").Copy Destination:=Worksheets("Display").Range("E6:AD6")
     
        End If
        
        
  Wan to run Code Here
        
        
        'Worksheets("Lab Report").Range("Q7:z200").Copy Destination:=Worksheets("Display").Range("K9:U9")
       ' Worksheets("Lab Report").Range("AA7:DA200").Copy Destination:=Worksheets("Display").Range("V9")
    

  
 '''2''''Worksheets("RetrievalReport").Range("A5").AutoFilter Field:=3, Criteria1:=Worksheets("Display").Range("B2")
   '''2''''Worksheets("RetrievalReport").Range("A5").AutoFilter Field:=4, Criteria1:=Worksheets("Display").Range("C2")
   '''2''''Worksheets("RetrievalReport").Range("A5").AutoFilter Field:=5, Criteria1:=Worksheets("Display").Range("D2")
    
  ' If Worksheets("RetrievalReport").Range("A5:A100").EntireRow.Hidden = True Then
   
 '''2''''If Worksheets("RetrievalReport").Range("A5:A100").SpecialCells(xlCellTypeVisible).Count > 1 Then
 
    '''2''''Worksheets("RetrievalReport").Range("C7:H200").Copy Destination:=Worksheets("Display").Range("K9")
'''2''''End If

  
    'Worksheets("Lab Report").UsedRange.Offset(2, 6).SpecialCells(xlCellTypeVisible).Copy _
    ' Destination:=Worksheets("Display").Range("B6")
   
   'Worksheets("Display").Range("C:C,J:J,L:L,P:Q,S:S,X:X,AB:AJ").EntireColumn.Hidden = True
    
    With Application
.CutCopyMode = False
.ScreenUpdating = True
End With
       'Worksheets("Lab Report").AutoFilterMode = False
       
       Worksheets("Lab Report").AutoFilter.ShowAllData
       Worksheets("RetrievalReport").AutoFilter.ShowAllData
   End Sub

Display More

Hello Carim ,

I have attached file for your reference.

**Carim** · Mar 26th 2021

As already indicated ... you do need to create a NEW THREAD ...

Below is an Image of the Main Menu ... with the Button + CREATE THREAD

VBA: Index match multiple criteria & autofill until last row with Column as ref

Participate now!

Share

Users Viewing This Thread