i've got this template from another post on here but cant figure out how to
add more collums to the database and make them show up in the search function
could anyone be so kind to assist me with this? would really apreciate it
data upload.xlsm
best regards
henrik
Pretty simple. Here is the macro and the modification you have to do:
That's it.
Sub SearchParts() Dim arrParts() As Variant Range("A7", "C" & Cells(Rows.CountLarge, "C").End(xlDown).Row).Clear 'Here the letter C used to be B. You set it to the last column in your database arrParts = FindParts(CStr(Trim(Cells(2, 2)))) Range("A7").Resize(UBound(arrParts, 2), UBound(arrParts)) = _ WorksheetFunction.Transpose(arrParts) End Sub Private Function FindParts(PartNumber As String) As Variant Dim ws As Worksheet Dim FoundCell As Range Dim LastCell As Range Dim rngParts As Range Dim FirstAddr As String Dim arrPart() As Variant Set ws = Worksheets("Data") Set rngParts = ws.Range("B2:B" & ws.Cells(Rows.CountLarge, "B").End(xlUp).Row) With rngParts Set LastCell = .Cells(.Cells.Count) End With Set FoundCell = rngParts.Find(What:=PartNumber, After:=LastCell, LookAt:=xlPart) If Not FoundCell Is Nothing Then FirstAddr = FoundCell.Address End If ReDim arrPart(1 To 3, 1 To 1) 'here 3 used to be 2 because there was only 2 columns in database 'you change it to the number of columns in your database Do Until FoundCell Is Nothing arrPart(1, UBound(arrPart, 2)) = FoundCell.Offset(0, -1) arrPart(2, UBound(arrPart, 2)) = FoundCell.Value arrPart(3, UBound(arrPart, 2)) = FoundCell.Offset(0, 1) 'Here you add as many line as you need to display all of your database columns. ReDim Preserve arrPart(1 To 3, 1 To UBound(arrPart, 2) + 1) 'Here too you change the 2 to the number of columns in your database Set FoundCell = rngParts.FindNext(After:=FoundCell) If FoundCell.Address = FirstAddr Then Exit Do End If Loop FindParts = arrPart End Function
Pierre Leclerc
_______________________________________________________
If you like the help you got,
Click on the STAR "Add reputation" icon at the bottom.
kinda a newb on this subjekt where do i go to add this information im on a very beginner lvl with this
I added some columns in your data sheet.
Then I used the code of p24leclec to fill the data.
Fill in the search Holder disk and see what's happening.
See the attached file.
Notice my main language is not English.
I appreciate it, if you reply on my solution.
If you are satisfied with the solution, please mark the question solved.
You can add reputation by clicking on the star * add reputation.
doesnt seem to work for me. nothing shows up in search when i search for something in the added collums
Have you accepted (to allow) macro's?
In my version (excel 2007) it works fine.
i have 2013 and i believe so yes
You have to input your data you want to search in cell B2. Confirm with enter.nothing shows up in search when i search for something in the added collums
After that you can push the button search.
anyway to make collum c and d in database seachable?
This one is for a search in column C.
See the attached file.
If you fill in main you get the data that are available.
how is it you add a collum to the seach ?
1) Does the second file does what you expected?
2) I changed the VBA code.
it really does tyvm!
changeing the VBA code is done how?
What does tyvm means?
2) Alt + F11
Then you get in the VBA editor.
On the left side you see a window.
There you find "module1" In this one you find the VBA code.
@oeldere: I suspect "thank you very much"
Regards, TMS
Trevor Shuttleworth - Retired Excel/VBA Consultant
I dream of a better world where chickens can cross the road without having their motives questioned
'Being unapologetic means never having to say you're sorry' John Cooper Clarke
How easy can that be (thank you very much).
Thanks for explaining it, TMShucks
changed to collum value from B to F and now nothing works
what have i dont wrong?
It's not easy to tell, without seeing your file.
Please post your excel file, without confidentional information.
does this help you?
Formula:
Sub SearchParts()
Dim arrParts() As Variant
Range("A7", "B" & Cells(Rows.CountLarge, "B").End(xlDown).Row).Clear
arrParts = FindParts(CStr(Trim(Cells(2, 2))))
Range("A7").Resize(UBound(arrParts, 2), UBound(arrParts)) = _
WorksheetFunction.Transpose(arrParts)
End Sub
Sub SearchParts_P24leclerc()
Dim arrParts() As Variant
Range("A7", "F" & Cells(Rows.CountLarge, "F").End(xlDown).Row).Clear
'Here the letter C used to be B. You set it to the last column in your database
arrParts = FindParts(CStr(Trim(Cells(2, 2))))
Range("A7").Resize(UBound(arrParts, 2), UBound(arrParts)) = _
WorksheetFunction.Transpose(arrParts)
End Sub
Private Function FindParts(PartNumber As String) As Variant
'made by P24leclec
Dim ws As Worksheet
Dim FoundCell As Range
Dim LastCell As Range
Dim rngParts As Range
Dim FirstAddr As String
Dim arrPart() As Variant
Set ws = Worksheets("Data")
Set rngParts = ws.Range("C2:C" & ws.Cells(Rows.CountLarge, "C").End(xlUp).Row)
With rngParts
Set LastCell = .Cells(.Cells.Count)
End With
Set FoundCell = rngParts.Find(What:=PartNumber, After:=LastCell, LookAt:=xlPart)
If Not FoundCell Is Nothing Then
FirstAddr = FoundCell.Address
End If
ReDim arrPart(1 To 4, 1 To 1)
'here 3 used to be 2 because there was only 2 columns in database
'you change it to the number of columns in your database
Do Until FoundCell Is Nothing
arrPart(1, UBound(arrPart, 2)) = FoundCell.Offset(0, -2)
arrPart(2, UBound(arrPart, 2)) = FoundCell.Offset(0, -1)
arrPart(3, UBound(arrPart, 2)) = FoundCell.Value
arrPart(4, UBound(arrPart, 2)) = FoundCell.Offset(0, 1)
'Here you add as many line as you need to display all of your database columns.
ReDim Preserve arrPart(1 To 4, 1 To UBound(arrPart, 2) + 1)
'Here too you change the 2 to the number of columns in your database
Set FoundCell = rngParts.FindNext(After:=FoundCell)
If FoundCell.Address = FirstAddr Then
Exit Do
End If
Loop
FindParts = arrPart
End Function
found i and changed value to From C to F
now nothing works:/
dont have permission to do that it seems attach function isnt availble for me
There are currently 1 users browsing this thread. (0 members and 1 guests)
Posting Permissions
LinkBack URL
About LinkBacks
Register To Reply
Bookmarks