Macro como buscador de google

Señores Todo expertos, deseo que en esta macro de búsqueda parecida a google, lo siguiente: que en las columnas de la hoja inventario: Clave Municipal y Población Total, los valores que busca la Macro los lleva sin estos comentarios detallando el nombre de cada columna, ejemplo, estos aparecen como una división:
Resultado de la búsqueda de ORA
Sonora
San Miguel de Horcasitas
26056
6036
Se podría en ves de esta forma, que aparezcan de esta otra forma discriminando los nombres de los valores así:
Sonora
San Miguel de Horcasitas
Clave Municipal 26056
Población Total 6036
El resaltado en negrilla, es lo que deseo que se agregue a la búsqueda de la Macro, detallando a que pertenecen los valores. Muchas Gracias.
Experto

Código Macro:

Public Sub BUSCADOR(datobuscar As String)
Dim filaInicio As Integer, columnaInicio As Integer, filaDato1 As Integer, filadato As Integer, columnaDato As Integer, i As Byte
Dim datoEncontrado
Dim contador As Integer
Dim cadenaValores As String
contador = 0
'ActiveSheet.Unprotect
Application.ScreenUpdating = False
Application.EnableEvents = False
With Range("zona")
.ClearContents 'Limpia el rango donde se muestra la búsqueda
.Font.Bold = False
.Font.Color = vbBlack
End With
filaInicio = Range("inicio").Row 'Fila del rango inicio ("$B$4"), varía si se modifica el formato de la hoja
columnaInicio = Range("inicio").Column 'Columna del rango inicio ("$B$4"), varía si se modifica el formato de la hoja
With Worksheets("INVENTARIO").Range("A1:D5000")
Set datoEncontrado = .Find(datobuscar)
If Not datoEncontrado Is Nothing Then
filaDato1 = datoEncontrado.Row
Do
filadato = datoEncontrado.Row
columnaDato = datoEncontrado.Column
For i = 0 To 3 'Cambiar el 3 por 4 si se requiere otra columna
cadenaValores = Sheets("INVENTARIO").Cells(filadato, i + 1).Value 'ID CAT
With ActiveSheet.Cells(filaInicio + i, columnaInicio)
.Value = cadenaValores
If i = 0 Then ActiveSheet.Hyperlinks.Add Anchor:=Range(.Address), Address:="", SubAddress:= _
"INVENTARIO!" & datoEncontrado.Address, TextToDisplay:=cadenaValores
If InStr(1, cadenaValores, datobuscar, 1) > 0 Then
.Characters(Start:=InStr(1, cadenaValores, datobuscar, 1), Length:=Len(datobuscar)).Font.Bold = True
End If
End With
Next
contador = contador + 1
filaInicio = filaInicio + 3 'Cambiar el 3 por 4 si se requiere otra columna
próxima:
Set datoEncontrado = .FindNext(datoEncontrado) 'Busca el siguiente dato
If datoEncontrado.Row = filadato Then filadato = filadato + 1: GoTo próxima:
filaInicio = filaInicio + 1
Loop While Not datoEncontrado Is Nothing And datoEncontrado.Row <> filaDato1
End If
End With
Sheets("PRINCIPAL").Label1.Caption = contador & " registros(s) encontrado(s)." 'Muestra en el Label 1 los registros encontrados
Application.EnableEvents = True
Application.ScreenUpdating = False
'ActiveSheet.Protect
End Sub