VBA - click on cell, open form / message box

[ashfire]

Hi,

Sheet 1, Column A holds unique Activity Numbers

Sheet 3, Column A holds Activity Numbers (may appear more than once) and Column C holds Issue Numbers


On Sheet 1 id like to click a cell in Column A and have a message box appear with the Issue numbers from sheet 3.


id like this to happen for each cell in Sheet 1 Column A.


Thanks. i hope that makes sense

 

[Hui]

Ashfire

In Sheet1, Why not simply in Column B2 put

=Sumproduct((Sheet3!A:A=A2)*(Sheet3!C:C))


Copy down

 

[Luke M]

You could possibly put all of this in VB, but one way to do it with a dashboard type look would be to create a setup like I describe here:

http://chandoo.org/wp/2011/11/18/formula-forensics-003/


Then, you would make the VB event macro get triggered to that whenever you click on a cell in col A, it changes the criteria cell that feeds the INDEX formulas. I personally would prefer this method so that I don't have to keep closing message boxes, and I can copy the data if I need to.

 

[Hui]

Or what about a Double Click using this:

[pre]

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Title = "Hows this"
Msg = "Sum of Cells matching " & CStr(Target.Address) & " = " & _
Evaluate("=SumProduct((Sheet3!A:A=" & CStr(Target.Address) & ")*(Sheet3!c:c))")
a = MsgBox(Msg, , Title)
SendKeys "{ESC}", True
End Sub

[/pre]

 

[DaveTurton]

very messy but here is some VBA code I have have wrote quickly. Not had time to test though...


Right click Sheet1 and select view code. Paste the below:

[pre]

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)

Application.ScreenUpdating = False

'check selection in in column A
If Not Intersect(Target, Range("A:A")) Is Nothing Then

Application.ScreenUpdating = True
Call Run_match

End If

End Sub

Then insert a new module and place the below in it:


Sub Run_match()

Dim Unique_number As String
Dim Issue_number() As String
Dim Msg_Text As String
Dim i As Integer
Dim j As Integer

'record unique number
Unique_number = ActiveCell.Value

'check how many times unique number appears in sheet 3
i = 0
Sheets("Sheet3").Select
Cells(1, 1).Select
Do
If ActiveCell.Value = Unique_number Then
i = i + 1
End If
ActiveCell.Offset(1, 0).Select
Loop Until IsEmpty(ActiveCell)

If i = 0 Then

Sheets("Sheet1").Select
MsgBox "No match found"
Application.ScreenUpdating = True

Exit Sub

Else
'redim array

ReDim Issue_number(1 To i) As String

'loop and record array

j = 1

Range("A1").Select
Do
If ActiveCell.Value = Unique_number Then
Issue_number(j) = ActiveCell.Offset(0, 2).Value
j = j + 1
End If
ActiveCell.Offset(1, 0).Select
Loop Until IsEmpty(ActiveCell)

j = j - 1

End If

Sheets("Sheet1").Select

'display message

Msg_Text = ""
For i = 1 To j

Msg_Text = Msg_Text & " " & Issue_number(i) & " "
Next i

MsgBox "Issue number(s): " & Msg_Text

End Sub

[/pre]
Once again apologies for the crudeness of it. No time to tidy it up

 

[ashfire]

thank you all, i will attempt these when i get some spare time at work and post back.


thanks again