search range, if exist, copy cell

[marcus76]

Hi,

Wondering if someone could help me out. Eg below.

1.) I want to define a value. Ideally click on the cell that contain
this value and have this read as the value. i.e click cell (A1) - an
read 'apple' as the value.

2.) Search a range (A1:A5) for this value. Where this value exists, a
that row number, select another value from a different column (C?) an
paste to area within worksheet (E)

3.) Increment the rows where the pasting is going to build a list o
values.

Any help on the syntax would be greatly appreciated.

Many thanks.

Marcus



Eg:

A B C D E
1 apple 1 1
2 apple 1 1
3 pear 2 1
4 banana 3
5 apple

 

[K Dales]

How about with a right-click on the cell?

The following code relies on two named ranges; SearchRange
for the range you are looking in for the match (A1:A5, in
your message) and ValueList (the top cell - only the one
cell - where you want your value list to begin). It uses
the BeforeDoubleClick event to activate it and checks for
a few possible error conditions. The Cancel=True at the
end will bypass the normal response to a right-click (e.g.
bringing up the context menu).


Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As
Object, ByVal Target As Range, Cancel As Boolean)

Dim CellVal As Variant, MatchRow As Integer, MatchFound As
Boolean

If Selection Is Nothing Then
MsgBox "Nothing Selected", vbExclamation
Exit Sub
End If

CellVal = Target.Value
If CellVal = "" Then
MsgBox "Empty Cell - no value to match!", vbExclamation
Exit Sub
End If

MatchFound = False
On Error GoTo Oops
MatchRow = WorksheetFunction.Match(CellVal, Range
("SearchRange"), 0)
MatchFound = True

Oops:
On Error GoTo 0
If Not (MatchFound) Then
MsgBox "No Match!", vbExclamation
Exit Sub
End If

CellVal = Range("SearchRange").Offset(MatchRow - 1,
2).Range("A1").Value

With Range("ValueList")
MatchRow = .CurrentRegion.Rows.Count
If .Range("A1").Value = "" Then MatchRow = 0
.Offset(MatchRow, 0).Value = CellVal
End With

Cancel = True

End Sub

 

[K Dales]

Uh, I meant of course the "SheetBeforeRightClick" event!
(Could also do this with a double-click)