Searching Information From Database.

Hello,

I am seeking for VBA Macros where i can display an information from my other sheet. Something like using filter.

Her are the details what i am looking for.

i have a sheet named Database. When i start typing the work from any of the columns on the sheet it should display the results.

More details will be provided if someone willing to help me. Cannot attached the file it is giving error 132KB.

Can someone help me please and why i cannot attached file as an sample.

Here is the link for my file CLICK HERE

I need to search the typed value in all the columns and display the result below in sheet search from Data sheet.

I have found this script but it is searching from column B. Can anyone help me to setup the range of columns uptill 15 columns.

Private Sub Search_Click()
    Dim rCl As Range
    Dim NR As Long
    Dim sFind As String
    Dim Movie As String

    If IsEmpty(Range("A2")) Then
        MsgBox "You haven't enter anything, please enter your search."
        Exit Sub
    End If
    'Erase old results
    Sheets("Search").Range("A5:K" & Rows.Count).ClearContents
    'List new results from all sheets
    sFind = Range("A2").Value
    With Worksheets("Data")
        For Each rCl In .UsedRange.Columns(1).Offset(1, 0).Cells
            Movie = rCl.Value
            If InStr(Movie, sFind) > 0 Then
                With Sheets("Search")
                    NR = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
                    .Cells(NR, 1).Value = rCl.Value          
                    .Cells(NR, 2).Value = rCl.Offset(, 7)    
                    .Cells(NR, 3).Value = rCl.Offset(, 4)    
                    .Cells(NR, 4).Value = rCl.Offset(, 15)   
                    .Cells(NR, 5).Value = rCl.Offset(, 16)   
                    .Cells(NR, 6).Value = rCl.Offset(, 20)   
                    .Cells(NR, 7).Value = rCl.Offset(, 22)   
                    .Cells(NR, 8).Value = rCl.Offset(, 23)   
                    .Cells(NR, 9).Value = rCl.Offset(, 24)   
                    '.Cells(NR, 10).Value = rCl.Offset(, 9)  
                    '.Cells(NR, 11).Value = rCl.Offset(, 10) 
                End With
            End If
        Next rCl
    End With

End Sub

hi there, re uploading file: it happens sometimes, try to zip it and post zipped

PS. The link provided above is not correct and leads to nothing

Thanks for your response.

Still problem remain the same here is the file LINK

The reason for a problem with uploading file:
there is a limit on Excel files allowed for uploading - 1000 KB. Your file (previous post link) shows 1018.5 KB. Zip it and it should go ok as always

I've successfully downloaded the file.

What is the maximum expected number of data rows for Sheet "Data"?

I have no idea i suggest to make it open because it is keep of adding the rows and columns presently i am using 25 columns and 13,000 rows but this is not fix.

please check attachment, try to search for some text (search is case-insensitive)

Thanks for reply and help.

It is giving error. Say following:

Run-time error '9':
Subscript out of range

Also it can be possible to remove case-insensitive

to remove case-insensitive: comment Option compare text line in Module 1

re error: try to change this line in code "test":

If Application.International(xlDecimalSeparator) = "." Then decsep = ";" Else decsep = ","

to this one:

If Application.International(xlDecimalSeparator) = "." Then decsep = "," Else decsep = ";"

You guys are genius. People like me are non professional we just think for a solution you guys just do it. Thanks for your very valuable help.

One more think if i want to add or delete any field name which line i have to change. I have 7 different file which i have to work on every week. So, these fields are having different fields.

Let say i don't want to see Contact person and his mobile. What should i do.

There is another issue if the data is not found it should give message Saying that data not found in your records

I giving error.

Run-time error '9':
Subscript out of range

Also i have to close the workbook and open it again if i found the error. can you fix it please.

check the file which gives error this is original file CLICK HERE

For password check your pm

The result is totally changed some record displayed correct and some are wrong.

Wrong means places of fields. You have my file file try to check clinic you will find the issue which i am notifying to you.

modified code to address coma inside field option:

Module 1 code:

Option Explicit
Option Compare Text ' comment this line to remove case-insensitive
Sub test()
Dim data, datafilt, result, rcount As Long, decsep As String, i As Long, n As Long, j As Long, temp

With Sheets("Search")
    
    If .Range("a2") = "" Then Exit Sub
    
    On Error Resume Next
    Open ActiveWorkbook.Path & Application.PathSeparator & "$$$trash$$$.csv" For Input As #1
    
    If Err.Number <> 0 Then
        Application.EnableEvents = 1
        MsgBox "File have to be closed. Please reopen it once again.", vbCritical
        ActiveWorkbook.Close 1
    End If
    On Error GoTo 0
    
    data = Split(Input(LOF(1), #1), vbCrLf)
    Close #1
    
    datafilt = Filter(data, .Range("a2"), 1)
    rcount = UBound(datafilt)
    
    If Application.International(xlDecimalSeparator) = "." Or Application.UseSystemSeparators = True Then decsep = "," Else decsep = ";"
    
    ReDim result(1 To rcount + 1, 0 To 15) 'no of fields
    
        If rcount > -1 Then
         
            For i = 0 To rcount

                 temp = Split(datafilt(i), decsep)
                 
                 j = j + 1
                 
                 For n = 0 To UBound(temp)
                 
                     result(j, n) = temp(n)
                     
                 Next
            
            Next
            
            Application.ScreenUpdating = 0
            
            .UsedRange.Offset(4).ClearContents
            
            With .Range("a5").Resize(j, n)
            
                .Value = result
                .Replace "###", ",", xlPart
                        
            End With
            
            Application.ScreenUpdating = 1
            
        Else
        
            MsgBox "No records containing search value have been found", vbInformation, "Search result"
            
        End If
    
    End With

End Sub

Thisworkbook level code:

Private Sub Workbook_BeforeClose(Cancel As Boolean)
On Error Resume Next
Kill ActiveWorkbook.Path & "\$$$trash$$$.csv"
End Sub

Private Sub Workbook_Open()
Application.ScreenUpdating = 0
decseparat = Application.DecimalSeparator
ipath = ActiveWorkbook.Path
On Error Resume Next
Kill ipath & Application.PathSeparator & "$$$trash$$$.csv"
On Error GoTo 0
With ActiveWorkbook
    With Sheets("Data")
        .Range("a2", .Cells(Rows.Count, 1).End(xlUp)).Resize(, .Cells(1, Columns.Count).End(xlToLeft).Column).Copy
        With Workbooks.Add
            With .Sheets(1)
                .Range("a1").PasteSpecial xlPasteValues
                .UsedRange.Replace ",", "###", xlPart
            End With
            .SaveAs (ipath & "\$$$trash$$$.csv"), FileFormat:=xlCSV
            .Close 0
        End With
    End With
End With
Application.ScreenUpdating = 1
End Sub

the wrong places of fields appear due to the fact that CSV file created uses coma as field separator but some fields have coma inside so split by coma later produces more fields then should be

So i have to remove comas from my entire database this is impossible for me. Have to take out some solution for this.

And what is this CSV file.

It id working fine but one more thing it the searching result not found it is giving error. It should give message saying data not found something like this.

corrected to avoid error if nothing found:

 
Option Explicit
Option Compare Text ' comment this line to remove case-insensitive
Sub test()
Dim data, datafilt, result, rcount As Long, decsep As String, i As Long, n As Long, j As Long, temp

With Sheets("Search")
    
    If .Range("a2") = "" Then Exit Sub
    
    On Error Resume Next
    Open ActiveWorkbook.Path & Application.PathSeparator & "$$$trash$$$.csv" For Input As #1
    
    If Err.Number <> 0 Then
        Application.EnableEvents = 1
        MsgBox "File have to be closed. Please reopen it once again.", vbCritical
        ActiveWorkbook.Close 1
    End If
    On Error GoTo 0
    
    data = Split(Input(LOF(1), #1), vbCrLf)
    Close #1
    
    datafilt = Filter(data, .Range("a2"), 1)
    rcount = UBound(datafilt)
    
    If Application.International(xlDecimalSeparator) = "." Or Application.UseSystemSeparators = True Then decsep = "," Else decsep = ";"
  
        If rcount > -1 Then
         
            ReDim result(1 To rcount + 1, 0 To 15) 'no of fields
            
            For i = 0 To rcount

                 temp = Split(datafilt(i), decsep)
                 
                 j = j + 1
                 
                 For n = 0 To UBound(temp)
                 
                     result(j, n) = temp(n)
                     
                 Next
            
            Next
            
            Application.ScreenUpdating = 0
            
            .UsedRange.Offset(4).ClearContents
            
            With .Range("a5").Resize(j, n)
            
                .Value = result
                .Replace "###", ",", xlPart
                        
            End With
            
            Application.ScreenUpdating = 1
            
        Else
            
            .UsedRange.Offset(4).ClearContents
            
            MsgBox "No records containing search value have been found", vbInformation, "Search result"
            
        End If
    
    End With

End Sub

Your 2nd script works fine but need small correction on empty search. If a user did not enter anything in the search box and press search button he should get a message saying you haven't enter anything in the search box.

Can it be possible and this will be last correction.

code "test", please change this:

If .Range("a2") = "" Then Exit Sub

to this:

If Application.Trim(.Range("a2")) = vbNullString Then
    
        MsgBox "Please input search criteria", vbCritical, "Search criteria error"
        
        Exit Sub
        
    End If

It works thanks for your most valuable help for me.Reputation added and topic marked as solved.