Function ColumnLength(ByVal column As String) As Integer                ' Obtains the length of specified column
    Dim row As Integer                                                  ' Hold row position
    row = 2                                                             ' Default to 2nd row (minus header)
    Do While Not Range(column & row) = ""                               ' While first cell of row isn't blank
        row = row + 1                                                   ' Increase row counter
    Loop
    ColumnLength = row - 1                                              ' Return correct column length
End Function

Function Position(ByVal column As String) As Integer                    ' Obtains position of specified column
    Dim col As Integer                                                  ' Hold column position
    col = 1                                                             ' Default to 1st column
    Do While Not Cells(1, col) = column                                 ' While the current position doesn't match arg
        If col = 255 Then                                               ' Max boundary of 255 columns
            Position = -1                                               ' Return error code
        End If
        col = col + 1                                                   ' Increase column
    Loop
    Position = col                                                      ' Return position that matches column arg
End Function

Function FurthestHeader() As Integer                                    ' Obtains furthest header in DAV file
    Dim col As Integer                                                  ' Hold column position
    col = 1                                                             ' Default to 1st column
    Do While Not Cells(1, col) = ""                                     ' While current column is not blank
        col = col + 1                                                   ' Increase column
    Loop
    FurthestHeader = col - 1                                            ' Return last column position
End Function

Function ColumnLetter(ByVal column As String) As String                 ' Obtain column header letter
    ColumnLetter = Split(Cells(1, Position(column)).Address, "$")(1)    ' Left side from the dollar sign converted from column address
End Function

Sub LithoMonster()
    Dim sampleFromText, sampleToText, lithoFromText, lithoToText, lithoCodeText As String               ' Text to search for in column header
    sampleFromText = "From"                                                                             ' Sample from
    sampleToText = "To"                                                                                 ' Sample to
    lithoFromText = "Lf"                                                                                ' Litho from
    lithoToText = "Lt"                                                                                  ' Litho to
    lithoCodeText = "Litho"                                                                             ' Litho code

    Dim sampleFromLetter, sampleToLetter, lithoFromLetter, lithoToLetter As String                      ' Obtain column header letters
    sampleFromLetter = ColumnLetter(sampleFromText)                                                     ' Sample from
    sampleToLetter = ColumnLetter(sampleToText)                                                         ' Sample to
    lithoFromLetter = ColumnLetter(lithoFromText)                                                       ' Litho from
    lithoToLetter = ColumnLetter(lithoToText)                                                           ' Litho to
    lithoCodeLetter = ColumnLetter(lithoCodeText)                                                       ' Litho code

    Dim sampleFromCell, sampleToCell, lithoFromCell, lithoToCell As Double                              ' Hold sample and litho from to's
    Dim SL As String                                                                                    ' Hold litho
    Dim count, highest As Integer                                                                       ' Multiple litho
    highest = count = 0                                                                                 ' Default to 0
    For dav = 2 To ColumnLength("A")                                                                    ' For each sample
        For litho = 2 To ColumnLength(lithoFromLetter)                                                  ' For each litho
            If Not Range(lithoToLetter & litho) = "EOH" And Not Cells(dav, Position("To")) = "" Then    ' Ignores EOH and DUP/HLF/STD/BLKs
                sampleFromCell = Range(sampleFromLetter & dav)                                          ' Obtains sample from as a double
                sampleToCell = Range(sampleToLetter & dav)                                              ' Obtains sample to as a double
                lithoFromCell = Range(lithoFromLetter & litho)                                          ' Obtains litho from as a double
                lithoToCell = Range(lithoToLetter & litho)                                              ' Obtains litho to as a double

                ' If litho from <= sample from and sample from < litho to
                ' or Litho from < sample to and sample to <= litho to
                ' or litho from <= sample from and sample to <= litho to
                If (lithoFromCell <= sampleFromCell) And (sampleFromCell < lithoToCell) _
                Or (lithoFromCell < sampleToCell) And (sampleToCell <= lithoToCell) _
                Or (lithoFromCell <= sampleFromCell) And (sampleToCell <= lithoToCell) _
                Then
                    SL = Range(lithoCodeLetter & litho)                                                 ' Save litho
                    Cells(dav, Position("Litho") + 2 + count) = SL                                      ' Current litho slot filled
                    count = count + 1                                                                   ' Increase counter for next possible litho
                    If count > highest Then                                                             ' Check if highest count
                        highest = count                                                                 ' Set the highest count
                    End If
                End If
            End If
        Next litho
        count = 0                                                                                       ' Reset litho counter for next pass-around
    Next dav
    For i = Position("Litho") + 2 To Position("Litho") + 2 + highest - 1                                ' Count number of lithos in a row
        Cells(1, i) = "SL (" & i - 16 & ")"                                                             ' Place adaquete amount of headers
    Next i
End Sub