Find header in worksheet, then return a value within that section (but a different column AND row)-CodePudding

I am trying to come up with a macro that will work on all sheets in my workbook. It needs to search for a specific "header" (there are 5 different headers that could be in a worksheet, but they won't all necessarily be there), and if it finds it, return a total that is within that section. However, the total is in a different column AND row than the header itself.

In the image below, there are two headers- "sales Commission" and "Sales Fee". Within each of those sections, there are dollar amounts, and a subtotal. I would like to run a macro that searches for Sales commission, and if it finds it, returns the total. Then it would look for "Sales Fee", and if it finds it, returns the total from that part of the sheet. If one of the headers is NOT present, it doesn't return anything.

Headers and values

CodePudding user response：

You can try this macro

enter exact header you want to find, then it gives out the subtotal.

Sub findheader()

Dim h As Integer
Dim s As String

s = InputBox("Enter header to find")
If Not Cells.Find(what:=s, After:=ActiveCell, LookIn:=xlFormulas2, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False) Is Nothing Then

Cells.Find(what:=s, After:=ActiveCell, LookIn:=xlFormulas2, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Activate
h = 6
For i = 1 To h
If Not ActiveCell.Resize(i, i).Find(what:="subtotal", After:=ActiveCell, LookIn:=xlFormulas2, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False) Is Nothing Then
h = i
ActiveCell.Resize(i, i).Find(what:="subtotal", After:=ActiveCell, LookIn:=xlFormulas2, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Activate
MsgBox Application.TextJoin(" ", True, ActiveCell.Resize(1, 2))
End If
Next i

End If
End Sub

Notes:

Assumed your subtotal is within 6 cells square from your header. If your data is longer, you can put multiplier to longer your limit e.g. Resize(i, i * multiplier), or you can control h limit (currently 6 cells) h = 6.
Assumed your subtotal title, and subtotal value are next together, if not please change resize from subtotal title cell ActiveCell.Resize(1, 2)

CodePudding user response：

`Application.Match` Instead of `Find`

Option Explicit


Sub GetTotalTEST()
    
    Const Header As String = "Sales Fee"
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    Dim ws As Worksheet: Set ws = wb.Worksheets("Sheet1")
    Dim Total As Double: Total = GetTotal(ws, Header)
    
    Debug.Print Total
    
End Sub


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose:      In a column ('fCol') of a worksheet's ('ws') used range,
'               it will try to find a string ('Header'). If found,
'               in the column adjacent to the right, from the found cell's row
'               towards the bottom, it will try to find another string
'               ('stString'). If found, and if the cell adjacent to the right
'               contains a number, it will return this number.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function GetTotal( _
    ByVal ws As Worksheet, _
    ByVal Header As String) _
As Double
    
    Const fCol As Long = 1
    Const stString As String = "Subtotal:"
    
    With ws.UsedRange.Columns(fCol)
        Dim fIndex As Variant: fIndex = Application.Match(Header, .Cells, 0)
        If IsError(fIndex) Then Exit Function ' 'Header' not found
        With .Resize(.Rows.Count - fIndex   1).Offset(fIndex - 1, 1)
            fIndex = Application.Match(stString, .Cells, 0)
            If IsError(fIndex) Then Exit Function ' subtotal string not found
            With .Cells(fIndex).Offset(, 1)
                If IsNumeric(.Cells) Then GetTotal = .Value ' it is a number
            End With
        End With
    End With
    
End Function

Application.Match Instead of Find

`Application.Match` Instead of `Find`