Do I need a control loop to produce worksheet?

[QuickLearner]

Please could somebody help me.
I have got so far and come to the end of my knowledge base, I need t
get further.
Here is my problem:
I have a workbook with two worksheets, the first (Database) is
collection of non-unique entries for items over time with se
priorities.
The second worksheet (Dataset), I want as a unique record of the item
from the first worksheet.
I have a sub routine behind the first worksheet that picks the righ
elements to go into the unique record, but at the moment it is onl
picking the elements from a dialogue box and showing the in th
immediate window.
What I would really like to do is for each of the items in column A i
‘Dataset’, get the elements from ‘Database’ sheet and put them agains
the matching item in ‘Dataset’.
I think I need some form of control loop, but it’s a bit beyond me.
I would be greatful if anyone could assist me in achieving this.

Here is the code behind ‘Database’ worksheet. I have attached picture
to show the elements.

Sub Aggregate()
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 variable names for worksheets and turn off auto filtering
'********************************************************************
Set sh1 = Worksheets("Database")
'Set sh2 = Worksheets("Dataset")
sh1.AutoFilterMode = False

With sh1
'*******************************************************************
'rng is a reference to the database (Item History) starting in row 2
'********************************************************************
Set rng = .Range(.Cells(2, 1), .Cells(Rows.Count, 2).End(xlUp)) _
.Resize(, 12)
End With

'*******************************************************************
' for testing purposes, open a dialogue box for part no.
'********************************************************************
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

'**********************************************************************
'filter on the selected
'***********************************************************************
rng.AutoFilter Field:=1, Criteria1:=ans

'***********************************************************************
' set up the initial variables that will hold the latest date for part
' information and the highest priority of source data and what row its
' held in.
'************************************************************************

'***********************************************************************
' Break point here to look at the worksheet filtering, open th
worksheet
' and check which are the values to be extracted
'***********************************************************************
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
'**********************************************************************
' looking for data in each of the filtered columns, if data exists loo
at
' its priority and date and record which has highest priority or most
' recent date. In this test data we are only interested in columns 3 t
9,
' this will have to be changed for the actual dataset.
'************************************************************************





'***************************************************************************

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 ro
3
Set rng2 = rng1.Columns(col).SpecialCells(xlVisible)


For Each cell In rng2
' check each row with a priority


If .Cells(cell.Row, col) <> "" Then
' it is a provider


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)
Else
Debug.Print "Row..." & highPriRow & " Value.." &
.Cells(highPriRow, col)
End If
'rngTocopy.Copy Destination:=sh2.Cells(2, 5)





' maxdate = 0
' maxDateRow = 0
' highPriRow = 0
'********************************************************************************
' reset high Priority
highPri = 11
Next col
End With
sh1.AutoFilterMode = False



sh1.AutoFilterMode = False

End Sub


+-------------------------------------------------------------------+
|Filename: DatabaseSheet.gif |
|Download: http://www.excelforum.com/attachment.php?postid=4938 |
+-------------------------------------------------------------------+

 

[lexcel]

Hi,

The link to your attachment doesn't work, but your explanation is
clear.
Indeed you came quite far already, you need just to make a loop to get
your data from the Dataset sheet.
Supposing you have all the keys in column 1 the loop could look like
this:
__________________________________________________________________________
Dim cell As Range
For Each cell In Sheets("Dataset").Columns(1).CurrentRegion.Rows
ans = cell

' Use ans for autofilter, process the data

Next r
__________________________________________________________________________

If you need more help let me know.

Greetz,

Lex