Announcement

Collapse
No announcement yet.

Need Help Hiding Database Sheet and Searching Range

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

  • 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

  • #2
    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

    Comment


    • #3
      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?

      Comment


      • #4
        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
        If you feel like saying "Thank You" for the help received ...You can click on the "Like" icon ...just underneath ... ... in the bottom right corner ...

        Comment


        • #5
          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.

          Comment


          • #6
            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 ...
            If you feel like saying "Thank You" for the help received ...You can click on the "Like" icon ...just underneath ... ... in the bottom right corner ...

            Comment


            • #7
              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"

              Comment


              • #8
                Attaching an updated file
                Attached Files

                Comment


                • #9


                  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; May 15th, 2019, 06:51.
                  We now have a reputation system in place. If my reply helped please "Like" the reply by clicking the "Like" icon at bottom right of my reply.

                  Comment

                  Working...
                  X