Excel VBA: Function findContent()

|

Find content in column1 with header xx, return value from same row in column2 with header yy.

'**********************************************************
'1) Find ColumnHeader from Header in row 1
'2) Find ColumnReturnHeader from ReturnHeader in row 1
'3) Find row number where Content is found in ColumnHeader
'4) Returns value in ColumnReturnHeader from row in 3)
'5) Error message is supressed if GoSilent is true
'**********************************************************
Function findContent(sh As Worksheet, Header As Variant, Content As Variant, _
ReturnHeader As Variant, Optional GoSilent As Boolean, _
Optional rowHeader As Long) As Variant

    Dim TableTop As Long
    If rowHeader = 0 Then
        TableTop = 1
    Else
        TableTop = rowHeader
    End If

    Dim rngColumnHeader As Range
    Set rngColumnHeader = sh.Range(TableTop & ":" & TableTop). _
    Find(What:=Header, LookIn:=xlValues, Lookat:=xlWhole)
    
    Dim rngColumnReturnHeader As Range
    Set rngColumnReturnHeader = sh.Range(TableTop & ":" & TableTop). _
    Find(What:=ReturnHeader, LookIn:=xlValues, Lookat:=xlWhole)
    
    If Not (rngColumnHeader Is Nothing Or rngColumnReturnHeader Is Nothing) Then

        
        With sh
                        
            Dim rngEnd As Range
            Set rngEnd = .Range(.Cells(sh.UsedRange.Rows.Count + TableTop, _
            rngColumnHeader.Column), .Cells(sh.UsedRange.Rows.Count + TableTop, _
            rngColumnHeader.Column))
            
            
            Dim rngSearch As Range
            Set rngSearch = .Range(.Cells(1, rngColumnHeader.Column), _
            .Cells(sh.UsedRange.Rows.Count + TableTop, rngColumnHeader.Column))
        
        End With

        Dim rngResult As Range
        Set rngResult = rngSearch.Find(What:=Content, LookIn:=xlValues, _
        Lookat:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, After:=rngEnd)
        
        If Not rngResult Is Nothing Then
            
            findContent = sh.Cells(rngResult.row, rngColumnReturnHeader.Column)
        
        End If

    Else
    
        If GoSilent = False Then
    
            Dim msg As String
    
            If rngColumnHeader Is Nothing Then
                msg = "Could not find Header '" & Header _
                & "' in row " & TableTop & " in sheet " & sh.Name
            End If
    
            If rngColumnReturnHeader Is Nothing Then
                msg = msg & Chr(10) & "Could not find ReturnHeader '" & ReturnHeader _
                & "' in row " & TableTop & " in sheet " & sh.Name
            End If
        
            If msg <> "" Then
                ErrMsg msg
            End If
    
        End If

    End If

End Function

Similar Posts