I would be very grateful if someone can help me with the following:
I want to search for a text (using Textbox) in a very large database. (for example searching for: Iron). The results I'm expecting would be like the following: "Red Iron", "Iron grey", "A very long iron" + copying the entire rows to another sheet (with the textbox name) and find the lowest price which is in range (D2:J). D1, E1, F1, G1, H1, I1, J1 are the suppliers. If it's possible I want to show the supplier name and the lowest price in a msgbox.
I want to search in range A:A.
Can anybody help me with this?
Many thanks, N.
Couple things to help you start, in case you've not tried any coding yourself...
.1) You can give yourself a Userform to input the desired term (you should be able to make the Userform yourself). Make sure to save that term outside of the code, so you can carry it through (in case you write multiple macros for each part):
Public burp as Text
Sub
Set burp = Userform(1).Textbox(1).Value 'Will need to tweak
End Sub
Sub NameOfNextSub()
.2) I haven't played much with the Find function, but I have done something similar to what you're wanting where I loop and match. If there's a match, it pastes the row matched within to the end of another sheet
Dim LR as Long
LR = Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row
For i = 1 to LR
If IsError(WorkSheetFunction.Match(*burp*,cells(i,2)),0)>0 Then
Sheets("Sheet1").Row(i).Copy
Sheets("Sheet2").Row(i).PasteSpecial xlPasteValues
Else:
End If
Next i
Delete_Empty_Rows 'runs macro named "Delete_Empty_Rows"
Google delete empty rows... you should gets tons of hits, doing it different ways; pick what feels best for you. Make sure it runs on Sheet2.
That's a pretty lazy way of doing it, but it will work.
.3) Filter Sheet2 based on whatever column has cost, xlAscending. Again, quick google on that. Will look something like:
Columns("A:C").Sort key1:=Range("C2"), _
order1:=xlAscending, header:=xlNo
.4) Since you know your lowest price will be in the top row, and you know the column, you can have a messagebox show up to display what's in that cell:
MsgBox "Lowest price: "&Cells(1,4)
That should get you ready to code up what you want, in VBA.
`Private Sub SearchCommandButton_Click()
`Dim searchitem As Variant
`Dim lr As Long
`Dim WSNew As Worksheet
`Dim sheetname As String
`Set searchitem = SearchUserForm.TextBox1.Value
`lr = Cells(Sheets("GC").Rows.Count, 1).End(xlUp).Row
`For i = 1 To lr
`If IsError(WorksheetFunction.Match(searchitem, Cells(i, 2)), 0) > 0 Then
`Sheets("GC").Row(i).Copy
`Else
`Set WSNew = Worksheets.Add(After:=Sheets(ActiveSheet.Index))
sheetname = searchitem
On Error Resume Next
WSNew.Name = sheetname
If Err.Number > 0 Then
MsgBox "We cannot match the search: " & WSNew.Name & _
" Please try again" & _
" Sheet already exist!" & _
" The sheet name cannot contain this!"
Err.Clear
End If
On Error GoTo 0
With WSNew.Range("A1")
.PasteSpecial Paste:=8
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
Application.CutCopyMode = False
.Select
End With
End If
End Sub `
I tried another coding. This one is identifying the text i'm looking for a copy and paste to an existing sheet. Clear contents at the beginning of the macro.
`Private Sub SearchCommandButton_Click()
Dim rFind As Range
Dim rCopy As Range
Dim strSearch As String
Dim sFirstAddress As String
Dim destsh As Worksheet
Sheets("comparelist").Activate
Sheets("comparelist").Range("A2:AA200").ClearContents
strSearch = TextBox1.Value
Set rCopy = Nothing
Application.ScreenUpdating = False
With Sheets("GC").Columns("A:A")
Set rFind = .Find(strSearch, LookIn:=xlValues, Lookat:=xlPart,SearchDirection:=xlNext, MatchCase:=False)
If Not rFind Is Nothing Then sFirstAddress = rFind.Address
Do
If rCopy Is Nothing Then
Set rCopy = rFind
Else
Set rCopy = Application.Union(rCopy, rFind)
End If
Set rFind = .FindNext(rFind)
Loop While Not rFind Is Nothing And rFind.Address <> sFirstAddress
rCopy.EntireRow.Copy
Sheets("comparelist").Activate
Sheets("comparelist").Range("A2").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Application.ScreenUpdating = True
Unload Me
Sheets("comparelist").Range("A1").Select
End If
End With
End Sub
What i'm trying to do next, is to compare values from columns D, I, N and R, the lowest to go yellow and the biggest value to go red, for each item. Can anybody help?
Many thanks! N.
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.