?
Solved

Need a search box for excel sheet

Posted on 2007-07-31
19
Medium Priority
?
996 Views
Last Modified: 2008-01-09
Hi,

I have a excel sheet which has many fields.Is there a way i have a box which asks me to search for what
Say i want to search for all rams with 512 MB and machine having 40 GB HDD.
Any combination of searches.

regards
Sharath
0
Comment
Question by:bsharath
  • 8
  • 7
  • 2
  • +1
18 Comments
 
LVL 10

Expert Comment

by:kacor
ID: 19606638
where would you like to search (hard drive, internet,...)?
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 19606657
Assuming you want to search a workbook for a number of parameters on the same row then the answer is yes, it will require a search box to take in the required parameters but if you can pre-define the requirements and sheet format(s) then it is possible.

i.e. search each row for the strings "512 MB" & "40 GB" is 'easy', searching specific columns for the same data is also possible but could involve more maintenance.

Can you clarify the requirement?

Chris
0
 
LVL 13

Expert Comment

by:hiteshgoldeneye
ID: 19606721
Sub asearch()
Dim searchcritera() as String , i as Integer, str2 as Variant,found as Boolean
Dim sh As Worksheet
str1 = InputBox("Enter searchvalue and searchcolumn separated by ,")
Do while str1<>""
    Redim Preserve searchcriteria(Ubound(searchcriteria)+1)
    searchcriteria(Ubound(searchcriteria)-1) = str1
    str1 = InputBox("Enter searchvalue and searchcolumnno separated by ,")
Loop
s2row = 1

Set sh = ActiveWorkbook.Sheets.Add(, ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count), , xlWorksheet)

    For i = 1 To Sheet1.UsedRange.Rows.Count
        found = true
         For j = 0 To UBound(searchcriteria)-1
              str2 = Split(searchcriteria(j),",")
              If UCase(Sheet1.Cells(i, Val(str2(1))).Value) = UCase(str2(0)) Then
               Else
                    found =false  
              End If
              if found then
                   Sheet1.Rows(i).Copy Destination:=sh.Rows(s2row + 1)
                 s2row = s2row + 1
             End if
          Next
       Next
 
End Sub

0
Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

 
LVL 11

Author Comment

by:bsharath
ID: 19606738
Hitesh i get a compile error.

---------------------------
Microsoft Visual Basic
---------------------------
Compile error:

Invalid ReDim
---------------------------
OK   Help  
---------------------------

ReDim Preserve searchcriteria(UBound(searchcriteria) + 1)
0
 
LVL 11

Author Comment

by:bsharath
ID: 19606739
kacor
I need to search on the excel in local machine
0
 
LVL 11

Author Comment

by:bsharath
ID: 19606740
chris_bottomley
The data i need to search can be in different colums and rows.
0
 
LVL 13

Expert Comment

by:hiteshgoldeneye
ID: 19606781
Sub asearch()
Dim searchcritera() As String, i As Integer, str2 As Variant, found As Boolean
Dim sh As Worksheet
ReDim searchcritera(0)
str1 = InputBox("Enter searchvalue and searchcolumn separated by ,")
Do While str1 <> ""
    ReDim Preserve searchcritera(UBound(searchcriteria) + 1)
    searchcriteria(UBound(searchcriteria) - 1) = str1
    str1 = InputBox("Enter searchvalue and searchcolumnno separated by ,")
Loop
s2row = 1

Set sh = ActiveWorkbook.Sheets.Add(, ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count), , xlWorksheet)

    For i = 1 To Sheet1.UsedRange.Rows.Count
        found = True
         For j = 0 To UBound(searchcriteria) - 1
              str2 = Split(searchcriteria(j), ",")
              If UCase(Sheet1.Cells(i, Val(str2(1))).Value) = UCase(str2(0)) Then
               Else
                    found = False
              End If
              If found Then
                   Sheet1.Rows(i).Copy Destination:=sh.Rows(s2row + 1)
                 s2row = s2row + 1
             End If
          Next
       Next
 
End Sub



0
 
LVL 11

Author Comment

by:bsharath
ID: 19606815
I get this,

---------------------------
Microsoft Visual Basic
---------------------------
Run-time error '13':

Type mismatch
---------------------------
OK   Help  
---------------------------

I am doing something wrong
I need to search for 45 and in colum C
So i put 45,C
I got this error.
0
 
LVL 13

Expert Comment

by:hiteshgoldeneye
ID: 19606824
yes you have to enter 45,3 for the above i.e searchvalue and then column no
0
 
LVL 11

Author Comment

by:bsharath
ID: 19606863
I get this.
---------------------------
Microsoft Visual Basic
---------------------------
Run-time error '13':

Type mismatch
---------------------------
OK   Help  
---------------------------
0
 
LVL 13

Expert Comment

by:hiteshgoldeneye
ID: 19606890
Sub asearch()
Dim searchcritera() As String, i As Integer, str2 As Variant, found As Boolean
Dim sh As Worksheet
ReDim searchcriteria(0)
str1 = InputBox("Enter searchvalue and searchcolumn separated by ,")
Do While str1 <> ""
    ReDim Preserve searchcriteria(UBound(searchcriteria) + 1)
    searchcriteria(UBound(searchcriteria) - 1) = str1
    str1 = InputBox("Enter searchvalue and searchcolumnno separated by ,")
Loop
s2row = 1

Set sh = ActiveWorkbook.Sheets.Add(, ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count), , xlWorksheet)

    For i = 1 To Sheet1.UsedRange.Rows.Count
        found = True
         For j = 0 To UBound(searchcriteria) - 1
              str2 = Split(searchcriteria(j), ",")
              If UCase(Sheet1.Cells(i, Val(str2(1))).Value) = UCase(str2(0)) Then
               Else
                    found = False
              End If
             
          Next
           If found Then
                 Sheet1.Rows(i).Copy Destination:=sh.Rows(s2row + 1)
                 s2row = s2row + 1
             End If
       Next
 
End Sub

0
 
LVL 11

Author Comment

by:bsharath
ID: 19607308
I get this debug
 If UCase(Sheet1.Cells(i, Val(str2(1))).Value) = UCase(str2(0)) Then

This is asking me for box netering continuesly and new sheets are creating without any data found

I have this in the file
Name      Age      Sex
Sharath      25      M
Sharath      24      M

When i put in the text as Sharath,24 then this data in 1st row should be copied


0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 19607323
BSHARATH

I am not ignoring you as such ...

I'm keeping deliberately quiet to avoid complications, as my solution would have involved creating a form onto which to enter the search parameters  i.e. search par 1, search par 2 etc.  Where if the search parameters would need to be associated with specific columns then the columns would also have their own box ... i.e. if you are working with Hitesh then better to focus on just the one solution at this level.

Chris
0
 
LVL 13

Expert Comment

by:hiteshgoldeneye
ID: 19607453
ok try this, it will go on asking till you click cancel for an inputbox
Sub asearch()
Dim searchcritera() As String, i As Integer, str2 As Variant, found As Boolean,addsheet as Boolean
Dim sh As Worksheet
ReDim searchcriteria(0)
str1 = InputBox("Enter searchvalue and searchcolumn separated by ,")
Do While str1 <> ""
    ReDim Preserve searchcriteria(UBound(searchcriteria) + 1)
    searchcriteria(UBound(searchcriteria) - 1) = str1
    str1 = InputBox("Enter searchvalue and searchcolumnno separated by ,")
Loop
s2row = 1


    For i = 1 To Sheet1.UsedRange.Rows.Count
        found = True
         For j = 0 To UBound(searchcriteria) - 1
              str2 = Split(searchcriteria(j), ",")
              If UCase(Sheet1.Cells(i, Val(str2(1))).Value) = UCase(str2(0)) Then
               Else
                    found = False
              End If
             
          Next
           If found Then
                 if not addsheet
                       Set sh = ActiveWorkbook.Sheets.Add(, ActiveWorkbook.Sheets    (ActiveWorkbook.Sheets.Count), , xlWorksheet)
                     addsheet = true
                 End if  
                 Sheet1.Rows(i).Copy Destination:=sh.Rows(s2row + 1)
                 s2row = s2row + 1
             End If
       Next
 
End Sub



   

0
 
LVL 11

Author Comment

by:bsharath
ID: 19607849
I get an rror.

If found Then
       if not addsheet
0
 
LVL 13

Expert Comment

by:hiteshgoldeneye
ID: 19607887
Sub asearch()
Dim searchcritera() As String, i As Integer, str2 As Variant, found As Boolean,addsheet as Boolean
Dim sh As Worksheet
ReDim searchcriteria(0)
str1 = InputBox("Enter searchvalue and searchcolumn separated by ,")
Do While str1 <> ""
    ReDim Preserve searchcriteria(UBound(searchcriteria) + 1)
    searchcriteria(UBound(searchcriteria) - 1) = str1
    str1 = InputBox("Enter searchvalue and searchcolumnno separated by ,")
Loop
s2row = 1


    For i = 1 To Sheet1.UsedRange.Rows.Count
        found = True
         For j = 0 To UBound(searchcriteria) - 1
              str2 = Split(searchcriteria(j), ",")
              If UCase(Sheet1.Cells(i, Val(str2(1))).Value) = UCase(str2(0)) Then
               Else
                    found = False
              End If
             
          Next
           If found Then
                 if not addsheet then
                       Set sh = ActiveWorkbook.Sheets.Add(, ActiveWorkbook.Sheets    (ActiveWorkbook.Sheets.Count), , xlWorksheet)
                     addsheet = true
                 End if  
                 Sheet1.Rows(i).Copy Destination:=sh.Rows(s2row + 1)
                 s2row = s2row + 1
             End If
       Next
 
End Sub

0
 
LVL 11

Author Comment

by:bsharath
ID: 19607908
If i click cancel ot click enter without any data get a 1004 error
What happens when i have
Sharath    24  M
Sharath  25  M
This data in 2 rows and i type 24,B
This does not display anything
0
 
LVL 13

Accepted Solution

by:
hiteshgoldeneye earned 2000 total points
ID: 19607990
Sub asearch()
Dim searchcritera() As String, i As Integer, str2 As Variant, found As Boolean, addsheet As Boolean
Dim sh As Worksheet
ReDim searchcriteria(0)
str1 = InputBox("Enter searchvalue and searchcolumn separated by ,")
Do While str1 <> ""
    ReDim Preserve searchcriteria(UBound(searchcriteria) + 1)
    searchcriteria(UBound(searchcriteria) - 1) = str1
    str1 = InputBox("Enter searchvalue and searchcolumnno separated by ,")
Loop
s2row = 1


    For i = 1 To Sheet1.UsedRange.Rows.Count
        found = True
         For j = 0 To UBound(searchcriteria) - 1
              str2 = Split(searchcriteria(j), ",")
              If UCase(Sheet1.Cells(i, str2(1)).Value) = UCase(str2(0)) Then
               Else
                    found = False
              End If
             
          Next
           If found Then
                 If Not addsheet Then
                       Set sh = ActiveWorkbook.Sheets.Add(, ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count), , xlWorksheet)
                     addsheet = True
                 End If
                 Sheet1.Rows(i).Copy Destination:=sh.Rows(s2row + 1)
                 s2row = s2row + 1
             End If
       Next
 
End Sub

0

Featured Post

Upgrade your Question Security!

Your question, your audience. Choose who sees your identity—and your question—with question security.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Do you use a spreadsheet like Microsoft's Excel?  Have you ever wanted to link out to a non excel file on your computer or network drive?  This is the way I found to do it!
This article describes how to use a set of graphical playing cards to create a Draw Poker game in Excel or VB6.
This Micro Tutorial will demonstrate how to create pivot charts out of a data set. I also added a drop-down menu which allows to choose from different categories in the data set and the chart will automatically update.
With the advent of Windows 10, Microsoft is pushing a Get Windows 10 icon into the notification area (system tray) of qualifying computers. There are many reasons for wanting to remove this icon. This two-part Experts Exchange video Micro Tutorial s…

621 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question