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