Modify Macro to search columns before rows

apply these changes

     Set rngFound = ws.Cells.Find(strFind, , xlValues, xlWhole, xlByColumns)
 ...............
    arrResults(ResultIndex, 1) = .EntireColumn.Find("*", .EntireColumn.Cells(.EntireColumn.Cells.Count), , , xlByRows).Text

hi m3k1rk, to address both issues:

Option Explicit

Sub btnSearch_Click()
    
    Dim ws As Worksheet
    Dim rngFound As Range
    Dim arrResults() As Variant
    Dim ResultIndex As Long
    Dim lInterval As Long
    Dim lNumCols As Long
    Dim strFirst As String
    Dim strFind As String

    strFind = Range("C3").Text
    If Len(strFind) = 0 Then
        Range("C3").Select
        MsgBox "Must provide a name to search for"
        Exit Sub
    End If
    
    lInterval = 5000
    lNumCols = 3
    ReDim arrResults(1 To lInterval, 1 To lNumCols)
    Range("C6:C" & Rows.Count).Resize(, lNumCols).ClearContents
    
    For Each ws In ActiveWorkbook.Sheets
        If ws.Name <> ActiveSheet.Name Then
            Set rngFound = ws.Cells.Find(strFind, , xlValues, xlWhole, xlColumns)
            If Not rngFound Is Nothing Then
                strFirst = rngFound.Address
                Do
                    If ResultIndex = lInterval Then
                        Cells(Rows.Count, "C").End(xlUp).Offset(1).Resize(ResultIndex, lNumCols).Value = arrResults
                        ReDim arrResults(1 To lInterval, 1 To lNumCols)
                        ResultIndex = 0
                    End If
                    ResultIndex = ResultIndex + 1
                    With rngFound.CurrentRegion
                        arrResults(ResultIndex, 1) = Intersect(rngFound.CurrentRegion.EntireColumn, ws.UsedRange.Resize(1)).Cells(1, 2)
                        arrResults(ResultIndex, 2) = Intersect(.Columns(1), ws.Rows(rngFound.Row)).Text
                        arrResults(ResultIndex, 3) = .Cells(1, 2).Text
                    End With
                    Set rngFound = ws.Cells.Find(strFind, rngFound, xlValues, xlWhole)
                Loop While rngFound.Address <> strFirst
            End If
        End If
    Next ws
    
    If ResultIndex > 0 Then
       With Cells(Rows.Count, "C").End(xlUp).Offset(1).Resize(ResultIndex, lNumCols)
            .Resize(, 1).NumberFormat = "m/d/yyyy"
            .Resize(, 1).Offset(, 1).NumberFormat = "#,##0.00_);[Red](#,##0.00)"
            .Value = arrResults
        End With
    End If

End Sub