populate data based on word using dictionary

Hi again Speed

Using a dictionary is a bit tricky but in the modified code below, I've got an input from the user then provided case-insensitive search results*, with Column G showing where the text was found (and G1 stating what text was searched for):

Sub test()
    Dim ws, a, i As Long, w, dic As Object
    Dim Srch As String, TempArray As Variant

    Set dic = CreateObject("Scripting.Dictionary")

    ' Get word from user and convert
    Srch = LCase(InputBox("Enter word to find", , "Application"))
    ' do nothing unless > 3 chars
    If Len(Srch) < 4 Then
        MsgBox "Try again with a word of 3 letters of more"
        Exit Sub
    End If

    For Each ws In Worksheets
     If ws.Name <> "MASTER" Then

         a = ws.Cells(1).CurrentRegion.Value
         For i = 2 To UBound(a, 1)
             ' compare Lower case value with Srch
             If LCase(a(i, 2)) = Srch Then
                 'collect values
                 w = Application.Transpose(Array(a(i, 1), a(i, 2), a(i, 3), a(i, 4), a(i, 5), a(i, 6), ws.Name & " cell B" & i))

                 If Not dic.exists(a(i, 2)) Then
                     ' add key and add values as item for found location
                     dic.Add Key:=a(i, 2), Item:=w
'
                 Else
                   ' otherwsier add to item
                   TempArray = dic(a(i, 2))
                    ReDim Preserve TempArray(1 To UBound(TempArray, 1), 1 To UBound(TempArray, 2) + 1)

                    ' add values to existing item
                    For k = 1 To UBound(TempArray, 1)
                       TempArray(k, UBound(TempArray, 2)) = w(k, 1)
                    Next k

                   dic(a(i, 2)) = TempArray
                 End If
             End If
         Next i
          End If
         Next ws

 With Sheets("MASTER")
    .Cells(1).CurrentRegion.Offset(1).ClearContents

    ' loop through dictionary
    For Each Key In dic

        TempArray = Application.Transpose(dic(Key))
        On Error Resume Next
        ' determine where to paste item values
        FreeRow = .Range("A" & .Rows.Count).End(xlUp).Row
        EndRow = FreeRow + UBound(TempArray, 1)
        ' correct for only one dictionary item
        If IsError(UBound(TempArray, 2)) Then
            Application.Transpose (TempArray)
            EndRow = FreeRow + 1
        End If
        With .Range("A" & FreeRow + 1 & ":G" & EndRow)
            .Value = TempArray
        End With
    Next Key

    ' clear and add borders
    .UsedRange.Borders.LineStyle = xlNone
    .Cells(1).CurrentRegion.Borders.LineStyle = xlContinuous
    ' write to G1
    .Cells(1, 7).Value = "Column G (Found Locations for text " & StrConv(Srch, vbProperCase) & ")"
  End With

    ' release memory
    Set dic = Nothing: w = Nothing
End Sub

* You'll see that I changed some instances of "Application" (e.g. to "APplication").

Hope this helps- if so, please select this Answer as Selected. 

Hi speed,

John has provided you with a good solution using the "dictioary" method.

I am not familiar with using "dictionary" so I am posting simpler code which checks each sheet for "Application" in column "B" and then copies that record (columns A thru F) to the next row of the "MASTER" sheet.

Option Explicit
'

Sub Copy_Matches()

Dim LrowMaster As Long
Dim ws As Worksheet
Dim LRws As Long
Dim a As Long

LrowMaster = Sheets("MASTER").Cells(Rows.Count, "A").End(xlUp).Row

For Each ws In Worksheets
    If ws.Name <> "MASTER" Then
    ws.Activate
    LRws = ws.Cells(Rows.Count, 1).End(xlUp).Row
    ws.Activate
        For a = 2 To LRws
                If Cells(a, 2) = "Application" Then
                    Range(Cells(a, 1), Cells(a, 6)).Copy _
                        destination:=Sheets("MASTER").Cells(LrowMaster + 1, 1)
                        LrowMaster = LrowMaster + 1
                End If
        Next
        Cells(1, 1).Select
    End If
Next ws

End Sub
'

Cheers   :-)