Hi;
I have a workbook with two sheets: Data and Results. My search button on the Results sheet will see what criteria has been entered in the criteria section of Results and then display rows in the Data sheet that match the Criteria. The matching rows are displayed in the Result section of the Result sheet.
While I can enter a value in the criteria range and get a response, whenever I clear the criteria and enter other values, the search always returns the same row; the first row in the 'data' sheet. I want to be able to both enter values in the same column in Criteria (values are ORed together) and values in different columns (values are ANDed together)
The bulk of the code follows. The MsgBox messages are there to echo back the various values that variables currently hold. Any ideas? All help is greatly appreciated.
Private Sub Search_Click()
Dim MaxResults As Integer, MyCol As Integer, ResultsRng As String
Dim MyRow As Integer, LastDataRow As Integer, DataRng As String
Dim CritRow As Integer, CritRng As String, RightCol As Integer
Dim TopRow As Integer, BottomRow As Integer, LeftCol As Integer
' the source data is in a worksheet called 'Data'
' *** MODIFY AND SET YOUR OWN RANGES ON THE FOLLOWING DECLARATIONS ***
' cell Data!E1 contains the last row number of data [=COUNT(E4:E100)+3]
MsgBox "Before declarations"
MsgBox LastDataRow
MsgBox Worksheets("Data").Range("E1").Value
LastDataRow = Worksheets("Data".Range("E1").Value
MsgBox LastDataRow
DataRng = "A3:H3" ' range of column headers for Data table
CritRng = "B3:I5" ' range of cells for Criteria table
ResultsRng = "B8:I8" ' range of headers for Results table
MaxResults = 1000 ' any value higher than the number of possible results
MsgBox "After declarations"
' **************** END OF DECLARATIONS *********************
' fix the data range to incorporate the last row
MsgBox "Before data range fix"
TopRow = Worksheets("Data".Range(DataRng).Row
MsgBox "TopRow= " & TopRow
LeftCol = Range(DataRng).Column
RightCol = LeftCol + Range(DataRng).Columns.Count - 1
DataRng = Range(Cells(TopRow, LeftCol), Cells(LastDataRow, RightCol)).Address
MsgBox "After data range fix"
' fix the results range to incorporate the last row
TopRow = Worksheets("Data".Range(ResultsRng).Row
MsgBox "TopRow= " & TopRow
LeftCol = Range(ResultsRng).Column
RightCol = LeftCol + Range(ResultsRng).Columns.Count - 1
ResultsRng = Range(Cells(TopRow + 1, LeftCol), Cells(MaxResults,
RightCol)).Address
Range(ResultsRng).ClearContents ' clear any previous results but not headers
ResultsRng = Range(Cells(TopRow + 1, LeftCol), Cells(MaxResults,
RightCol)).Address
' fix the criteria range and identify the last row containing any items
TopRow = Range(CritRng).Row
MsgBox "TopRow= " & TopRow
BottomRow = TopRow + Range(CritRng).Rows.Count - 1
MsgBox "BottomRow= " & BottomRow
LeftCol = Range(CritRng).Column
MsgBox "LeftCol= " & LeftCol
RightCol = LeftCol + Range(CritRng).Columns.Count - 1
MsgBox "RightCol= " & RightCol
CritRow = 0
For MyRow = TopRow To BottomRow
MsgBox "MyRow=" & MyRow
For MyCol = LeftCol To RightCol
MsgBox "MyCol=" & MyCol
MsgBox "Cells(MyRow,MyCol).Value=" & Cells(MyRow, MyCol).Value
If Cells(MyRow, MyCol).Value <> "" Then CritRow = MyRow
MsgBox "CritRow= " & CritRow
Next
Next
MsgBox " Before If CritRow= " & CritRow
If CritRow = 0 Then
MsgBox "No Criteria detected"
Else
CritRng = Range(Cells(TopRow - 1, LeftCol), Cells(CritRow, RightCol)).Address
MsgBox "DataRng= " & DataRng
MsgBox "CritRng= " & CritRng
MsgBox "ResultsRng= " & ResultsRng
MsgBox "Worksheets(Results).Range(CritRng)= " &
Worksheets("Results").Range(CritRng).Address
Worksheets("Data").Range(DataRng).AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Worksheets("Results").Range(CritRng),
CopyToRange:=Worksheets("Results").Range(ResultsRng), _
Unique:=True
End If
Range("A5".Select
End Sub
I have a workbook with two sheets: Data and Results. My search button on the Results sheet will see what criteria has been entered in the criteria section of Results and then display rows in the Data sheet that match the Criteria. The matching rows are displayed in the Result section of the Result sheet.
While I can enter a value in the criteria range and get a response, whenever I clear the criteria and enter other values, the search always returns the same row; the first row in the 'data' sheet. I want to be able to both enter values in the same column in Criteria (values are ORed together) and values in different columns (values are ANDed together)
The bulk of the code follows. The MsgBox messages are there to echo back the various values that variables currently hold. Any ideas? All help is greatly appreciated.
Private Sub Search_Click()
Dim MaxResults As Integer, MyCol As Integer, ResultsRng As String
Dim MyRow As Integer, LastDataRow As Integer, DataRng As String
Dim CritRow As Integer, CritRng As String, RightCol As Integer
Dim TopRow As Integer, BottomRow As Integer, LeftCol As Integer
' the source data is in a worksheet called 'Data'
' *** MODIFY AND SET YOUR OWN RANGES ON THE FOLLOWING DECLARATIONS ***
' cell Data!E1 contains the last row number of data [=COUNT(E4:E100)+3]
MsgBox "Before declarations"
MsgBox LastDataRow
MsgBox Worksheets("Data").Range("E1").Value
LastDataRow = Worksheets("Data".Range("E1").Value
MsgBox LastDataRow
DataRng = "A3:H3" ' range of column headers for Data table
CritRng = "B3:I5" ' range of cells for Criteria table
ResultsRng = "B8:I8" ' range of headers for Results table
MaxResults = 1000 ' any value higher than the number of possible results
MsgBox "After declarations"
' **************** END OF DECLARATIONS *********************
' fix the data range to incorporate the last row
MsgBox "Before data range fix"
TopRow = Worksheets("Data".Range(DataRng).Row
MsgBox "TopRow= " & TopRow
LeftCol = Range(DataRng).Column
RightCol = LeftCol + Range(DataRng).Columns.Count - 1
DataRng = Range(Cells(TopRow, LeftCol), Cells(LastDataRow, RightCol)).Address
MsgBox "After data range fix"
' fix the results range to incorporate the last row
TopRow = Worksheets("Data".Range(ResultsRng).Row
MsgBox "TopRow= " & TopRow
LeftCol = Range(ResultsRng).Column
RightCol = LeftCol + Range(ResultsRng).Columns.Count - 1
ResultsRng = Range(Cells(TopRow + 1, LeftCol), Cells(MaxResults,
RightCol)).Address
Range(ResultsRng).ClearContents ' clear any previous results but not headers
ResultsRng = Range(Cells(TopRow + 1, LeftCol), Cells(MaxResults,
RightCol)).Address
' fix the criteria range and identify the last row containing any items
TopRow = Range(CritRng).Row
MsgBox "TopRow= " & TopRow
BottomRow = TopRow + Range(CritRng).Rows.Count - 1
MsgBox "BottomRow= " & BottomRow
LeftCol = Range(CritRng).Column
MsgBox "LeftCol= " & LeftCol
RightCol = LeftCol + Range(CritRng).Columns.Count - 1
MsgBox "RightCol= " & RightCol
CritRow = 0
For MyRow = TopRow To BottomRow
MsgBox "MyRow=" & MyRow
For MyCol = LeftCol To RightCol
MsgBox "MyCol=" & MyCol
MsgBox "Cells(MyRow,MyCol).Value=" & Cells(MyRow, MyCol).Value
If Cells(MyRow, MyCol).Value <> "" Then CritRow = MyRow
MsgBox "CritRow= " & CritRow
Next
Next
MsgBox " Before If CritRow= " & CritRow
If CritRow = 0 Then
MsgBox "No Criteria detected"
Else
CritRng = Range(Cells(TopRow - 1, LeftCol), Cells(CritRow, RightCol)).Address
MsgBox "DataRng= " & DataRng
MsgBox "CritRng= " & CritRng
MsgBox "ResultsRng= " & ResultsRng
MsgBox "Worksheets(Results).Range(CritRng)= " &
Worksheets("Results").Range(CritRng).Address
Worksheets("Data").Range(DataRng).AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Worksheets("Results").Range(CritRng),
CopyToRange:=Worksheets("Results").Range(ResultsRng), _
Unique:=True
End If
Range("A5".Select
End Sub