vlookup, with more than 1 result

[glen]

Hello,

Problem;
I have a vlookup set up between 2 worksheets with the possibility of
results. I need to record all possible results in column C under eac
other. Is there a way insert rows to include all possible results usin
VB code. I have tried a few other way using formulas but have come th
conclusion that VB code must be the answer. I have not dealt with
high level of VB so a detailed response would be greatly appreciated.

Example;
I am trying set up a spreadsheet to calculate bonuses, depending o
your position there are certain objectives. In 1st sheet is a list o
employees and their positions and on the second is the position wit
their objectives. I want to extract the objectives for each employe
according to their position.

SHEET 1
Collum A Collum B
John Smith Sales Manager
Greg Hobbs Branch Manager

SHEET 2
Collum A Collum B
Sales Manager Revenue
Sales Manager Income
Sales Manager America's & Pacific RAC
Branch Manager Utilisation
Branch Manager Branch Revenue
Branch Manager Pre Tax Income

Result;
SHEET 1
Column A Collum B Collum C
John Smith Sales Manager Revenue
Sales Manager Income
Sales Manager America's & Pacifi
RAC
Greg Hobbs Branch Manager Utilisation
Branch Manager Branch Revenue
Branch Manager Pre Tax Income

Thank

 

[Nigel]

Hi Glen
Try putting the following code behind sheet 1.
Whenever a user enters a new value into column B (the job title) on sheet ,
each objective for that job title on sheet2 is filled in to the right of the
cell just changed.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Lastrow As Long, Lastcol As Integer
Lastrow = Worksheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Row
Lastcol = Cells.Find(What:="*", SearchDirection:=xlPrevious,
SearchOrder:=xlByColumns).Column
If Target.Column = 2 Then
Range(Cells(Target.Row, 3), Cells(Target.Row,
Lastcol)).ClearContents
Dim i As Long, Tcol As Long
Tcol = 3
For i = 3 To Lastrow
If Target = Worksheets("Sheet2").Cells(i, 1).Text Then
Cells(Target.Row, Tcol) = Worksheets("Sheet2").Cells(i,
2).Text
Tcol = Tcol + 1
End If
Next
End If
End Sub

 

[Tom Ogilvy]

You appear to have assessed the situation correctly.
Formulas can't insert rows, so if you want to do that, you would need to
write a macro that counts the number of matching postions, inserts 1 minus
that number of rows, then writes the data to those cells. You can do that
using countif in you macro to get the number, then loop through the data on
sheet2 to get the values you need to write.

This assumes your data starts in Row1 of each sheet.

Sub WriteData()
Dim i As Long, j As Long, k As Long
Dim k2 As Long, k1 As Long, numMatches As Long
Dim rng As Range, lastrow As Long
With Worksheets("Sheet2")
Set rng = .Range(.Cells(1, 1), .Cells(1, 1).End(xlDown))
k2 = rng.Rows(rng.Rows.Count).Row
k1 = 1
End With
With Worksheets("Sheet1")
lastrow = .Cells(Rows.Count, 1).End(xlUp).Row


For i = lastrow To 1 Step -1
numMatches = Application.CountIf(rng, .Cells(i, 2))

.Cells(i + 1, 1).Resize(numMatches - 1).EntireRow.Insert
j = i + numMatches - 1
For k = k2 To 1 Step -1
If rng(k, 1).Value = .Cells(i, 2) Then
.Cells(j, 3).Value = rng(k, 2).Value
If j <> i Then _
.Cells(j, 2).Value = .Cells(i, 2).Value
j = j - 1
End If
Next
Next
End With
End Sub