Announcement

Collapse
No announcement yet.

Need Help Hiding Database Sheet and Searching Range

Collapse
X
  • Filter
  • Time
  • Show
Clear All
new posts

  • funfex
    started a topic Need Help Hiding Database Sheet and Searching Range

    Need Help Hiding Database Sheet and Searching Range

    Hi,

    I Made a database using codes i found on the freeweb and needed some additional Help
    1. I need to hide the Database Sheet, however the macro doesnt work if i do so. Can anyone help me with hiding/unhiding part
    2. I need the Macro to search text from Cloumns B to Column I. The Macro i found on the web is to search a single column and doesnt search partial words.

    Could someone helpme with this please.
    Attached Files

  • KjBox
    replied
    Try the attached, I have included "All" in the dropdown list for cell B2 validation, Also moved this list to the database sheet (so it cannot be seen by users). This code will work whilst keeping the database sheet hidden.

    Code now assigned to the button
    Code:
    Option Explicit
    
    Sub SearchCriteria()
        Dim x, y, z, i As Long, ii As Long, iii As Long
        Dim s As String, s1 As String, lCnt As Long
        
        x = Sheet2.Cells(1).CurrentRegion
        ReDim y(1 To UBound(x, 1) - 1, 1 To UBound(x, 2))
        s = "*" & LCase([b2]) & "*"
        z = Split(LCase([f2]))
        If IsArray(z) Then
            For i = LBound(z) To UBound(z)
                s1 = s1 & "*" & z(i)
            Next
            s1 = s1 & "*"
        Else
            s1 = "*" & z & "*"
        End If
        
        If Not s Like "*all*" Then
            For i = 2 To UBound(x, 1)
                If LCase(x(i, 1)) Like s Then
                    For ii = 2 To UBound(x, 2)
                        If LCase(x(i, ii)) Like s1 Then
                            lCnt = lCnt + 1
                            For iii = 1 To UBound(y, 2)
                                y(lCnt, iii) = x(i, iii)
                            Next
                            Exit For
                        End If
                    Next
                End If
            Next
        Else
            For i = 2 To UBound(x, 1)
                For ii = 2 To UBound(x, 2)
                    If LCase(x(i, ii)) Like s1 Then
                        lCnt = lCnt + 1
                        For iii = 1 To UBound(y, 2)
                            y(lCnt, iii) = x(i, iii)
                        Next
                        Exit For
                    End If
                Next
            Next
        End If
        
        [a5].CurrentRegion.Offset(1).ClearContents
        [a6].Resize(UBound(y, 1), UBound(y, 2)) = y
            
    End Sub
    Attached Files
    Last edited by KjBox; 4 weeks ago.

    Leave a comment:


  • funfex
    replied
    Attaching an updated file
    Attached Files

    Leave a comment:


  • funfex
    replied
    The code I'm using giving me alot of random errors like duplicates. Can you assist me with the proper code?? Is it possible to search for multiple words ? For example if i search for "quick fox" it should give me with row with "the quick brown fox"

    Leave a comment:


  • Carim
    replied
    Hello,

    Based on :

    Now the only issue i am facing with the above is, it searches only one Column i.e. Cells(i, 2), Can it be made to search multiple columns like columns 2 to column 10 ?
    Just proposed a tiny modification to your macro ...

    Did not take the time to review it ... nor to correct all the inefficiencies ...

    Leave a comment:


  • funfex
    replied
    Hey Carim,

    This works fine, however if i Keep F2 blank, it copies the same rows multiple times.
    I put a Validation that F2 cant be empty to avoid this.

    Additionally, I was thinking for having a "ALL" option as well for Cell B2, is there anyway to add a Loop to do this? coz my database will not be having ALL written in it.
    Last edited by KjBox; April 18th, 2019, 06:51.

    Leave a comment:


  • Carim
    replied
    Hi,

    To be tested ...

    Code:
    Sub SearchCriteriaTwo()
    ' SearchCriteriaTwo Macro
    Dim datasheet As Worksheet
    Dim reportsheet As Worksheet
    Dim SearchName As String
    Dim SectorName As String
    Dim i As Integer, j As Integer
    Dim finalrow As Integer
    Dim result As String
    
    '  "*" & LCase(TextBox1.Value) & "*"
    Set datasheet = Sheet2
    Set reportsheet = Sheet1
    SectorName = reportsheet.Range("B2").Value
    SearchName = "*" & LCase(reportsheet.Range("F2").Value) & "*"
    
    'Clear old data
    reportsheet.Range("A6:L150").ClearContents
    
    'Goto datasheet and start searching
    datasheet.Visible = xlSheetVisible
    datasheet.Select
    finalrow = Cells(Rows.Count, 1).End(xlUp).Row
    
    ' Loop
      For i = 2 To finalrow
        For j = 2 To 10
            If Cells(i, 1) = SectorName And LCase(Cells(i, j)) Like SearchName Then               ' if the name in A matches search name then copy
               Range(Cells(i, 1), Cells(i, 12)).Copy                                              ' copy columns 1 to 12 (A to L)
               reportsheet.Select                                                                 ' go to report sheet
               Range("A200").End(xlUp).Offset(1, 0).PasteSpecial xlPasteFormulasAndNumberFormats  ' find the first row
               datasheet.Select                                                                   ' go back searching loop
            End If
        Next j
      Next i
    
    datasheet.Visible = xlSheetHidden
    reportsheet.Select
    
    Range("B2").Select
    End Sub
    Hope this will help

    Leave a comment:


  • funfex
    replied
    I've Updated my code to hide the tab and also search partial text.

    Code:
    Sub SearchCriteriaTwo()
    '
    ' SearchCriteriaTwo Macro
    Dim datasheet As Worksheet
    Dim reportsheet As Worksheet
    Dim SearchName As String
    Dim SectorName As String
    Dim i As Integer
    Dim finalrow As Integer
    Dim result As String
    
    '  "*" & LCase(TextBox1.Value) & "*"
    Set datasheet = Sheet2
    Set reportsheet = Sheet1
    SectorName = reportsheet.Range("B2").Value
    SearchName = "*" & LCase(reportsheet.Range("F2").Value) & "*"
    
    'Clear old data
    reportsheet.Range("A6:L150").ClearContents
    
    'goto datasheet and start searching
    datasheet.Visible = xlSheetVisible
    datasheet.Select
    finalrow = Cells(Rows.Count, 1).End(xlUp).Row
    
    For i = 2 To finalrow
        If Cells(i, 1) = SectorName And LCase(Cells(i, 2)) Like SearchName Then ' if the name in A matches search name then copy
           Range(Cells(i, 1), Cells(i, 12)).Copy 'copy columns 1 to 12 (A to L)
           reportsheet.Select ' go to report sheet
           Range("A200").End(xlUp).Offset(1, 0).PasteSpecial xlPasteFormulasAndNumberFormats ' find the first row
           datasheet.Select ' go back searching loop
           End If
    Next i
    
    datasheet.Visible = xlSheetHidden
    reportsheet.Select
    
    Range("B2").Select
    
    '
    End Sub
    Now the only issue i am facing with the above is, it searches only one Column i.e. Cells(i, 2), Can it be made to search multiple columns like columns 2 to column 10?

    Leave a comment:


  • Logit
    replied
    Using these macros, you can hide your Database sheet :

    Code:
    Option Explicit
    
    Sub Search_Extract()
    '
    Dim datasheet As Worksheet
    Dim reportsheet As Worksheet
    Dim SearchName As String
    Dim SectorName As String
    Dim i As Integer
    Dim finalrow As Integer
    
    Set datasheet = Sheet2
    Set reportsheet = Sheet1
    SectorName = reportsheet.Range("B2").Value
    Application.ScreenUpdating = False
    'Clear old data
    reportsheet.Range("A6:L150").ClearContents
    
    'goto datasheet and start searching
    datasheet.Activate
    finalrow = Cells(Rows.Count, 1).End(xlUp).Row
    
    For i = 2 To finalrow
        If Cells(i, 1) = SectorName Then ' if the name in A matches search name then copy
           Range(Cells(i, 1), Cells(i, 12)).Copy 'copy columns 1 to 12 (A to L)
           reportsheet.Select ' go to report sheet
           Range("A200").End(xlUp).Offset(1, 0).PasteSpecial xlPasteFormulasAndNumberFormats ' find the first row
           datasheet.Select ' go back searching loop
           End If
    Next i
    
    reportsheet.Activate
    
    Range("B2").Select
    
    Application.ScreenUpdating = True
    End Sub
    Sub SearchCriteriaTwo()
    '
    ' SearchCriteriaTwo Macro
    Dim datasheet As Worksheet
    Dim reportsheet As Worksheet
    Dim SearchName As String
    Dim SectorName As String
    Dim i As Integer
    Dim finalrow As Integer
    Dim result As String
    
    
    Set datasheet = Sheet2
    Set reportsheet = Sheet1
    SectorName = reportsheet.Range("B2").Value
    SearchName = reportsheet.Range("F2").Value
    
    Application.ScreenUpdating = False
    'Clear old data
    reportsheet.Range("A6:L150").ClearContents
    
    'goto datasheet and start searching
    datasheet.Activate
    finalrow = Cells(Rows.Count, 1).End(xlUp).Row
    
    For i = 2 To finalrow
        If Cells(i, 1) = SectorName And Cells(i, 7) = SearchName Then ' if the name in A matches search name then copy
           Range(Cells(i, 1), Cells(i, 9)).Copy 'copy columns 1 to 12 (A to L)
           reportsheet.Select ' go to report sheet
           Range("A200").End(xlUp).Offset(1, 0).PasteSpecial xlPasteFormulasAndNumberFormats ' find the first row
           datasheet.Activate ' go back searching loop
           End If
    Next i
    
    reportsheet.Select
    
    Range("B2").Select
    Application.ScreenUpdating = True
    '
    End Sub

    Leave a comment:

Working...
X