andrianocaras
New Member
- Joined
- Jan 25, 2016
- Messages
- 4
hello right now i was making a search enggine using VBA
with sheet 1 as database and sheet 2 as search enggine i have code like this :
my code is search enggine that search a data that contain an alphabet or number where the data being search anyone can change this so that the criteria for searching is between 2 date
Sub Seartch()
Dim sCol As String
Dim rgFind As Range, rgData As Range, rgCell As Range
Dim iCol As Integer
Dim lRow As Long
Dim vCrit As Variant
Sheet2.Range(Sheet2.Range("b9"), Sheet2.Range("b9").End(xlToRight).End(xlDown)).ClearContents
sCol = Sheet2.Range("c2").Value
Set rgFind = Sheet1.Range("a17:s17").Find(sCol, lookat:=xlWhole, MatchCase:=True)
iCol = rgFind.Column
lRow = Sheet1.Range("a17").CurrentRegion.Rows.Count
vCrit = Sheet2.Range("c4").Value
Set rgData = Sheet1.Range(Sheet1.Cells(18, iCol), Sheet1.Cells(lRow, iCol))
For Each rgCell In rgData
Set rgFind = rgCell.Find(vCrit, lookat:=xlPart, MatchCase:=False)
If Not rgFind Is Nothing Then
Sheet1.Range(Sheet1.Cells(rgCell.Row, 1), Sheet1.Cells(rgCell.Row, 19)).Copy
Sheet2.Cells(Sheet2.Rows.Count, 2).End(xlUp).Offset(1).PasteSpecial xlPasteValuesAndNumberFormats
Application.CutCopyMode = False
End If
Next rgCell
Range("c4").Select
End Sub
with sheet 1 as database and sheet 2 as search enggine i have code like this :
my code is search enggine that search a data that contain an alphabet or number where the data being search anyone can change this so that the criteria for searching is between 2 date
Sub Seartch()
Dim sCol As String
Dim rgFind As Range, rgData As Range, rgCell As Range
Dim iCol As Integer
Dim lRow As Long
Dim vCrit As Variant
Sheet2.Range(Sheet2.Range("b9"), Sheet2.Range("b9").End(xlToRight).End(xlDown)).ClearContents
sCol = Sheet2.Range("c2").Value
Set rgFind = Sheet1.Range("a17:s17").Find(sCol, lookat:=xlWhole, MatchCase:=True)
iCol = rgFind.Column
lRow = Sheet1.Range("a17").CurrentRegion.Rows.Count
vCrit = Sheet2.Range("c4").Value
Set rgData = Sheet1.Range(Sheet1.Cells(18, iCol), Sheet1.Cells(lRow, iCol))
For Each rgCell In rgData
Set rgFind = rgCell.Find(vCrit, lookat:=xlPart, MatchCase:=False)
If Not rgFind Is Nothing Then
Sheet1.Range(Sheet1.Cells(rgCell.Row, 1), Sheet1.Cells(rgCell.Row, 19)).Copy
Sheet2.Cells(Sheet2.Rows.Count, 2).End(xlUp).Offset(1).PasteSpecial xlPasteValuesAndNumberFormats
Application.CutCopyMode = False
End If
Next rgCell
Range("c4").Select
End Sub