LinkBack URL
About LinkBacks
Hi All
I am hoping that someone could assist me in a problem I have.
I have a database consisting of three worksheets. The main worksheet is "Database" which records the history of items pricing and repair information, which change over time.
For each item I want to exctract the most relevant data values and populate these into a single row in a second sheet called "Dataset".
With me so far????
I have written a procedure that looks at filters the database against the item no, then looks at the source document that supplied the information. These are prioritised, so that it will get the information from the highest priority document or the latest information with a lower priority.
What I would like to do is look up each number in the dataset and get the extracted elements from the database to populate the dataset row.
To make it clearer I have attached the workbook. At the moment I am only running the procedure in the VBE to see if its getting the right values (which are written to the Immediate window). This seems to work, but only by inputting a number to filter.
I think I need help to go any further, or is there an easier way of doing this??
The code is in the database worksheet but is reproduced here:
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 the 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 look 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 to 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 row 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
Register To Reply
Bookmarks