I have a workbook with 2 worksheets.
At he moment I have a dialog that asks me to input a number. It then
filters a range on that number and loops to find cells that meet a
criteria.
These cells are then copied to a single row (from the second coulmn) in
the second worksheet.

What I want to do is replace the dialog and replace it with a loop that
uses the number value in the first column of the second worksheet to to
extract the cells and copy to each row of the second worksheet after
the corresponding number.

I keep getting tripped up here, any advise?

The sub on the first worksheet is:

Sub extract()
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim rng As Range
Dim rng1 As Range
Dim rng2 As Range
Dim ans As String


Set sh1 = Worksheets("Database")
Set sh2 = Worksheets("Dataset")
sh1.AutoFilterMode = False
sh2.AutoFilterMode = False

With sh1

Set rng = .Range(.Cells(2, 1), .Cells(Rows.Count, 2).End(xlUp)) _
..Resize(, 12)
End With


ans = InputBox("Enter Item Number")

If ans = "" Then Exit Sub
If Application.Count(rng.Columns(1), ans) = 0 Then
MsgBox "Not found"
Exit Sub
End If

rng.AutoFilter Field:=1, Criteria1:=ans


maxDate = 0
maxDateRow = 0
highPriRow = 0
highPri = 11 ' assume a pri of 1 is the highest and 10 is the lowest
Dim col As Integer

With sh1
For col = 2 To 8
' rng1 is a reference to the database starting in row 3 - data only -
' no headers
Set rng1 = rng.Offset(1).Resize(rng.Rows.Count - 1, 11)
' rng2 is a refence to the visible cells in column L - starting in row
3
Set rng2 = rng1.Columns(col).SpecialCells(xlVisible)


For Each cell In rng2
' check each row in highPri column


If .Cells(cell.Row, col) < "" Then
' if cell in not empty


If .Cells(cell.Row, 11) < highPri Then
highPri = Cells(cell.Row, 11).Value
highPriRow = cell.Row
End If

If .Cells(cell.Row, 10) = maxDate Then
maxDate = .Cells(cell.Row, 10)
maxDateRow = cell.Row

End If

End If

Next

If .Cells(maxDateRow, 11) = highPri And .Cells(maxDateRow, col) <
"" Then
Debug.Print "Row..." & highPriRow & " Value.." &
..Cells(maxDateRow, col)
..Cells(maxDateRow, col).Copy Destination:=sh2.Cells(2, col)
Else
Debug.Print "Row..." & highPriRow & " Value.." &
..Cells(highPriRow, col)
..Cells(highPriRow, col).Copy Destination:=sh2.Cells(2, col)
End If

' reset high Priority
highPri = 11
Next col
End With
sh1.AutoFilterMode = False

__________________________________________________ ____________

I am not sure how to place the loop to make this work.


Cheers

Wayne


--
QuickLearner
------------------------------------------------------------------------
QuickLearner's Profile: http://www.excelforum.com/member.php...o&userid=35483
View this thread: http://www.excelforum.com/showthread...hreadid=555609