Help! (I need somebody)

  • Thread starter Thread starter Nic@Rolls-Royce
  • Start date Start date
N

Nic@Rolls-Royce

HELP!!

I need to know is they a way I can use a piece of VBA to lookup data i
column A of a 'output' speadsheet, search in column A of a 'database
spreadsheet (these are not in any order) then copy value in column B o
the same row of the 'database' spreadsheet into column B of th
'output' spread sheet..

It needs to do this for all 1000 lines on the output spreadsheet an
ignore no matches found by proceeding to the next....


At present it uses VLookup formula, which altough works makes th
computer draw to a standstill..



Cheers


Ni
 
This might give you an idea

Sub Colorit2()
For Each cel In [colorlist]
With Worksheets("yourws").Cells
Set c = .Find(cel, LookAt:=xlWhole)
If Not c Is Nothing Then
firstAddress = c.Address
Do
c.Interior.ColorIndex = 46
c.Font.ColorIndex = 2
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With
Next cel
End Sub
 
This macro is using find next to look in at each cell in a range named
colorlist. Then see if there is a match in the yrorws worksheet. If so then
color it....Then do it again until there is no match. Then go on to the next
item in colorlist. You should be able to adapt to your specific need. Try
it.

Sub Colorit2()
For Each cel In [colorlist]
With Worksheets("yourws").Cells
Set c = .Find(cel, LookAt:=xlWhole)
If Not c Is Nothing Then
firstAddress = c.Address
Do
c.Interior.ColorIndex = 46
c.Font.ColorIndex = 2
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With
Next cel
End Sub
 
It is basically the help example from the find method and illustrates how
you can find multiple instances of a value on a spreadsheet.

I assume you only need to fine a unique match to your data.

Dim sh as worksheet, sh1 as worksheet
Dim rng1 as range, rng2 as range, rng3 as range
set sh = Worksheets("Output")
set sh1 = Worksheets("Database")
set rng1 = sh.Range(sh.Cells(1,1),sh.Cells(rows.count,1).End(xlup))
set rng2 = sh1.Range(sh1.Cells(1,1),sh1.Cells(rows.count,1).End(xlup))
for each cell in rng1
set rng3 = rng2.find(what:=cell.Value, Lookat:=xlWhole)
if not rng3 is nothing then ' found match
cell.offset(0,1).Value = rng3.offset(0,1).Value
else
cell.offset(0,1).Value = "No Match"
end if
Next
 
Back
Top