I made a couple of assumptions for test purposes.
I put a sheet called "Company Names" in the current sheet and populated it
with ID and Company Names.
If you put it in another workbook, just change the "Thisworkbook.Name" to the
appropriate name (and the sheet name "Company Names" to the appropriate one).
I also made use of the Worksheet Change event to watch for changes to column 1
(you can use another column by changing the value of Col_CompID)
Also, I duplicated the code to allow for copying multiple lines.
Normally, I would have written this as a function and passed the
target address to the function.
do you know where to put this change event? (it goes in the sheet module, not a
"standard" module)
(watch for line breaks when this is posted)
hope this helps:
paul
'====================================================================
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim CompCnt, DataRange, Data, CompName, i, Col_CompID
On Error Resume Next
Col_CompID = 1
If Target.Count = 1 Then
If Target.Column = Col_CompID Then
Range(Target.Address).ClearComments
If (Target.Value <> "") Then
CompName = ""
CompCnt =
Application.WorksheetFunction.CountA(Workbooks(ThisWorkbook.Name).Sheets("CompanyNames").Range("A1:A65000"))
Set DataRange =
Workbooks(ThisWorkbook.Name).Sheets("CompanyNames").Range("A2:A" & CompCnt)
For Each Data In DataRange.Columns(1).Cells
If (UCase(Data.Value) = UCase(Target.Value)) Then
CompName =
Workbooks(ThisWorkbook.Name).Sheets("CompanyNames").Cells(Data.Row, 2)
Exit For
End If
Next Data
If (CompName <> "") Then
Range(Target.Address).AddComment
Range(Target.Address).Comment.Visible = False
Range(Target.Address).Comment.Text Text:=CompName
End If
End If
End If
Else ' if multiple lines are added
For i = 1 To Target.Count
If Target(i).Column = Col_CompID Then
Range(Target(i).Address).ClearComments
If (Target(i).Value <> "") Then
CompName = ""
CompCnt =
Application.WorksheetFunction.CountA(Workbooks(ThisWorkbook.Name).Sheets("CompanyNames").Range("A1:A65000"))
Set DataRange =
Workbooks(ThisWorkbook.Name).Sheets("CompanyNames").Range("A2:A" & CompCnt)
For Each Data In DataRange.Columns(1).Cells
If (UCase(Data.Value) = UCase(Target(i).Value)) Then
CompName =
Workbooks(ThisWorkbook.Name).Sheets("CompanyNames").Cells(Data.Row, 2)
Exit For
End If
Next Data
If (CompName <> "") Then
Range(Target(i).Address).AddComment
Range(Target(i).Address).Comment.Visible = False
Range(Target(i).Address).Comment.Text Text:=CompName
End If
End If
End If
Next i
End If
On Error GoTo 0
End Sub
________________________________
From: Dave <davidstev...@gmail.com>
To: MS EXCEL AND VBA MACROS <excel-macros@googlegroups.com>
Sent: Wednesday, May 27, 2009 6:28:41 PM
Subject: $$Excel-Macros$$ A Macro needed for the task beow
Hi,
I have a spreadsheet that contains a company code in cell A3 to A150.
This company code uniquely identifies a company. These codes ones
assigned are not transferred to another company. What I want to do is
when a user clicks in a cell with the company code I want to reference
its company name. This way the user is not running around looking up
company names that are stored an another excel file . The company
codes are as follows:
0010-BBBB
0010-CCCC
0013-0000
0015-0100
0041-WOKS
So if a user clicks on cell a1 containing 0010-BBBB I want to return
Big Bass Outfitters and if they click in the cell contusing 0010-CCCC
I want to display Canada Water and so on and so forth
I was thinking about a macro some how adding automatic comments by
looking up the company codes against the company name and inserting
comments. But I am not sure if its a good solution and if it can be
done.
All suggestions are welcome.
Please reply here or reply to may email,
thanks,
Dave
--~--~---------~--~----~------------~-------~--~----~
-------------------------------------------------------------------------------------
Some important links for excel users:
1. Excel and VBA Tutorials(Video and Text), Free add-ins downloads at
http://www.excelitems.com
2. Excel tutorials at http://www.excel-macros.blogspot.com
3. Learn VBA Macros at http://www.vbamacros.blogspot.com
4. Excel Tips and Tricks at http://exceldailytip.blogspot.com
To post to this group, send email to excel-macros@googlegroups.com
If you find any spam message in the group, please send an email to:
Ayush Jain @ jainayus...@gmail.com or
Ashish Jain @ 26may.1...@gmail.com
-------------------------------------------------------------------------------------
-~----------~----~----~----~------~----~------~--~---
