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 ...
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 ...
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
Hello,
Attached is your last TURBO version... which deserves the V6 attribute ... !!!
Hope this will solve all issues
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
Glad to hear you have finalized your project ...
Thanks a lot ... for both your Thanks AND for the Like ...
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.
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
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 ...
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
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 ...
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.
Don’t have an account yet? Register yourself now and be a part of our community!