Search entire workbook return all results in Excel : Refined search

0

Hi everyone,

In the attached file, on the sheets "Dashboard", I want to be able to do the followings

  • Search and return results by only using the searched value (that should not be case-sensitive) in Cell C5
  • Expand the searched area from Column 2 to 13 on the other sheets (Commercial Banks, DFIs...)
  • The searched value in C5 could be more than one word

Below is the code and the attached file

Sub Data_Search()

' TeachExcel.com

Dim ws As Worksheet

Dim Dashboard As Worksheet

Dim dataArray As Variant

Dim datatoShowArray As Variant

'Application.ScreenUpdating = False 'Turning off for the macro can speed things up - not so much here though.

'Dashboard sheet

Set Dashboard = Sheets("Dashboard")

Set Data = Sheets("Data")

'Data table information

dataColumnStart = 2

dataColumnEnd = 16

dataColumnWidth = dataColumnEnd - dataColumnStart ' Number of columns for the raw data (+1 not included because it makes lower calculations more confusing)

dataRowStart = 17

dashboardDataColumnStart = 2 ' Column for the data on the dashboard

'Get user input

searchvalue = Dashboard.Range("C5").Value

fieldValue = Dashboard.Range("E5").Value

'Clear Dashboard

Call Clear_Data

'Figure out by which field we will search.

If (fieldValue = "ID") Then

    searchField = 1

ElseIf (fieldValue = "Name") Then

    searchField = 2

End If

'Loop through the worksheets

For Each ws In Worksheets

    'Ignore the Dashboard worksheet

    If (ws.Name <> "Dashboard" And ws.Name <> "Data") Then

        'Get the range values into a variable that can be looped through.

        'Example usage: dataArray(1,1) [row,column]

        'Simple version: ws.Range(Cells(1,1),Cells(2,2)).Value

        dataArray = ws.Range(ws.Cells(dataRowStart, dataColumnStart), ws.Cells(ws.Cells(Rows.Count, dataColumnStart).End(xlUp).Row, dataColumnEnd)).Value

        'Increase size of array that will hold the data to display to its max possible size for the current worksheet.

        ReDim datatoShowArray(1 To UBound(dataArray, 1), 1 To UBound(dataArray, 2))

        'Row increment for the final data array (datatoShowArray).

        j = 1

        'Loop through the rows in the data range.

        For i = 1 To UBound(dataArray, 1)

            'Check if the value in the row equals our search value

            'If (dataArray(i, searchField) = searchValue) Then

            If searchField = 2 And Left(dataArray(i, searchField), Len(searchvalue)) = searchvalue Then

                'MATCH FOUND! Now do something!

                'Loop through the columns in the data range so can get their values.

                For k = 1 To UBound(dataArray, 2)

                    'Add values to the array that will be used to put data into the Dashboard.

                    datatoShowArray(j, k) = dataArray(i, k)

                Next k

                'Increment the counter for the datatoShowArray

                j = j + 1

            End If

        Next i

        'Find next empty row in the dashboard.

        nextRow = Dashboard.Cells(Rows.Count, dashboardDataColumnStart).End(xlUp).Row + 1

        'Put data into the dashboard.

        'Format = Range(Cells(1,1),Cells(2,2)).Value = datatoShowArray

        Dashboard.Range(Cells(nextRow, dashboardDataColumnStart), Cells(nextRow + UBound(datatoShowArray, 1) - 1, dashboardDataColumnStart + dataColumnWidth)).Value = datatoShowArray

    End If

'Go to the next worksheet.

Next ws

' CondFormat Macro

    Range("B18:P1000").FormatConditions.Add Type:=xlExpression, Formula1:="=$B18<>"""""

    'Range("B18:P1000").FormatConditions(Selection.FormatConditions.Count).SetFirstPriority

    With Range("B18:P1000").FormatConditions(1).Font

        .Bold = True

        .Italic = False

        .Color = -7709384

        .TintAndShade = 0

        With Range("B18:P1000").Font

            .Name = "Tahoma"

            .Size = 8

            .Strikethrough = False

            .Superscript = False

            .Subscript = False

            .OutlineFont = False

            .Shadow = False

            .Underline = xlUnderlineStyleNone

            .ThemeColor = xlThemeColorLight1

            .TintAndShade = 0

            .ThemeFont = xlThemeFontNone

        End With

        With Range("B18:P1000").FormatConditions(1).Borders(xlBottom)

            .LineStyle = xlContinuous

            .ThemeColor = 1

            .TintAndShade = -0.499984740745262

            .Weight = xlThin

        End With

        With Range("B18:P1000").FormatConditions(1).Interior

            .PatternColorIndex = xlAutomatic

            .ThemeColor = xlThemeColorDark1

            .TintAndShade = -4.99893185216834E-02

        End With

        Range("B18:P1000").FormatConditions(1).StopIfTrue = True

    End With

'Application.ScreenUpdating = True 'Turn it back on at the end of the macro!

End Sub

Sub Clear_Data()

'Dashboard sheet

    Set Dashboard = Sheets("Dashboard")

'Data table information

dashboardDataColumnStart = 2 ' Column for the data on the dashboard

dashboardDataRowStart = 18

Dashboard.Range(Dashboard.Cells(dashboardDataRowStart, dashboardDataColumnStart), Dashboard.Cells(Rows.Count, Columns.Count)).Clear

With Range("R1:XFD1048576").Interior

        .Pattern = xlSolid

        .PatternColorIndex = xlAutomatic

        .ThemeColor = xlThemeColorDark1

        .TintAndShade = -0.499984740745262

        .PatternTintAndShade = 0

    End With

    With Range("B18:Q1000").Interior

        .Pattern = xlSolid

        .PatternColorIndex = xlAutomatic

        .ThemeColor = xlThemeColorDark1

        .TintAndShade = 0

        .PatternTintAndShade = 0

    End With

    Range("B18:P1000").Borders(xlDiagonalDown).LineStyle = xlNone

    With Range("B18:P1000").Borders(xlEdgeLeft)

        .LineStyle = xlContinuous

        .ThemeColor = 5

        .TintAndShade = -0.499984740745262

        .Weight = xlThin

    End With

    Range("B18:P1000").Borders(xlEdgeTop).LineStyle = xlNone

    With Range("B18:P1000").Borders(xlEdgeRight)

        .LineStyle = xlContinuous

        .ThemeColor = 5

        .TintAndShade = -0.499984740745262

        .Weight = xlThin

    End With

    With Range("B18:P1000").Borders(xlInsideVertical)

        .LineStyle = xlContinuous

        .ThemeColor = 5

        .TintAndShade = -0.499984740745262

        .Weight = xlThin

    End With

    Range("B18:P1000").Borders(xlInsideHorizontal).LineStyle = xlNone

End Sub

Answer
Discuss

Discussion

Have you tried to get this to work yet? Where exactly are you stuck?
don (rep: 1979) May 21, '21 at 6:46 am
I'm stuck here exactly:
'Figure out by which field we will search.
If (fieldValue = "ID") Then
    searchField = 1
ElseIf (fieldValue = "Institution") Then
    searchField = 2


For any value in Cell C5 of sheets "Dashboard", I want the macro to search in all the columns (Institution, Category, Country...) and return the results.
Chairmanbk (rep: 2) May 21, '21 at 7:23 am
Add to Discussion

Answers

0

Chairmanbk

Please try the attached revision to your workbook- it should allow you to search all columns (by making Dashboard cell E5 nothing) or only in individual fields (by picking from the data validation options via the down arrow on E5).

The searches are case-insensitive  and you can search for a phrase (in cell C5) or any words or phrases separated by the separator (" OR " at present but you can change that in the code)- there's an example in the file I've sent (where I changed an email value to a different number).

I won't repeat all the code below but the main changes are shown by comments including ### below (and ... indicates one or more lines of code have been omitted below). I use a dummy Do loop to stop searching  when  any value is round in (the array equivalent of) a given row of a worksheet. The line in bold is where you would change the search phrase separator (e.g. from " OR " to "*" if you want to use search strings like "Bahrain*2345":

Sub Data_Search()
' Code modified from TeachExcel.com
…
'Set Data = Sheets("Data") '### NOT USED
…
Dim SearchArray() As String
    SearchArray = Split(Dashboard.Range("C5").Value, " OR ") '### use an array for search values, converting cell input to elements
…
'Figure out by which field we will search. '### skip this bit
'If (fieldValue = "ID") Then
   ' searchField = 1
'ElseIf (fieldValue = "Name") Then
    'searchField = 2
'End If
…
    If ws.Name <> "Dashboard" Then '### don't need ...And ws.Name <> "Data"
…
        'Loop through the rows in the data range.
        For i = 1 To UBound(dataArray, 1)
            '### Add dummy Do loop to exit once value is found....
            Do
            ' ### Loop through columns
            For h = 1 To UBound(dataArray, 2)
            'Check if the value in the row equals our search value ### OR search is all fields
            If ws.Cells(dataRowStart - 1, dataColumnStart + h - 1) = fieldValue Or fieldValue = "" Then ' ### used alternative

                'If searchField = 2 And Left(dataArray(i, searchField), Len(searchvalue)) = searchvalue Then ' ### used alternative

                For n = 0 To UBound(SearchArray)
                    ' ### make a case-insensitive search of array element
                    If InStr(1, LCase(dataArray(i, h)), LCase(SearchArray(n))) <> 0 Then

                    'MATCH FOUND! Now do something!
                        'Loop through the columns in the data range so can get their values.
                        For k = 1 To UBound(dataArray, 2)

                            'Add values to the array that will be used to put data into the Dashboard.
                            datatoShowArray(j, k) = dataArray(i, k)

                        Next k

                    'Increment the counter for the datatoShowArray
                    j = j + 1
                    '### also skip searching other values and/or fields (to avoid duplicates)
                    Exit Do 'Exit dummy Do loop....

                End If
                Next n
            End If
            Next h
            Loop Until True 'End of Dummy do loop (doesn't repeat since no real test!)
        Next i

        'Find next empty row in the dashboard.
        nextRow = Dashboard.Cells(Rows.Count, dashboardDataColumnStart).End(xlUp).Row + 1

        'Put data into the dashboard.
        'Format = Range(Cells(1,1),Cells(2,2)).Value = datatoShowArray
        Dashboard.Range(Cells(nextRow, dashboardDataColumnStart), Cells(nextRow + UBound(datatoShowArray, 1) - 1, dashboardDataColumnStart + dataColumnWidth)).Value = datatoShowArray

    End If

'Go to the next worksheet.
Next ws
End Sub

Hope this does what you want.

Discuss

Discussion

This is exactly what I wanted! You did a great job and it works perfectly. Thanks very much
Chairmanbk (rep: 2) May 24, '21 at 7:05 pm
Thanks Chairman. Please don't forget to mark the Answer as Selected- it helps others find working answers plus increases your reputation and mine on the Forum.
John_Ru (rep: 2467) May 25, '21 at 1:44 am
Add to Discussion


Answer the Question

You must create an account to use the forum. Create an Account or Login