Obtain hidden ranges within a range

getHiddenRange.bas

'Gets all hidden range subsets within a range.
'@param r - Range to find hidden ranges within
'@returns - All hidden range within `r`
Public Function getHiddenRange(ByVal r As Range) As Range
    Dim oVisible As Object: Set oVisible = CreateObject("Scripting.Dictionary")
    Dim rVisible As Range: Set rVisible = r.SpecialCells(xlCellTypeVisible)
    If rVisible.Address = r.Address Then
      Set getHiddenRange = Nothing
      Exit Function
    End If
    
    Dim sVisible As String: sVisible = rVisible.Address(True, True, xlR1C1)
    Dim VisibleAddresses: VisibleAddresses = Split(sVisible, ",")
    Dim VisibleAddress
    For Each VisibleAddress In VisibleAddresses
      If InStr(1, VisibleAddress, ":") = 0 Then
        oVisible(VisibleAddress) = True
      Else
        Dim span: span = parseRange(VisibleAddress)
        Dim i As Long
        For i = span(1) To span(3)
          Dim k As Long
          For k = span(2) To span(4)
            oVisible("R" & i & "C" & k) = True
          Next
        Next
      End If
    Next
    
    Dim hiddenAddress As String
    span = parseRange(r.Address(True, True, xlR1C1))
    For i = span(1) To span(3)
      For k = span(2) To span(4)
        Dim sKey As String: sKey = "R" & i & "C" & k
        If Not oVisible.exists(sKey) Then
          hiddenAddress = hiddenAddress & "," & getA1Address(i, k)
        End If
      Next
    Next
    
    Set getHiddenRange = Range(Mid(hiddenAddress, 2))
End Function

'Parse a range R1C1 style address, specifically of the form `R\d+C\d+:R\d+C\d+`
'@param addr - The address to parse
'@returns Array<Long> - Array of longs depicting the bounds of the range
Private Function parseRange(ByVal addr As String) As Long()
  ReDim ret(1 To 4) As Long
  Dim i As Long: i = 1
  Call consume(addr, i, "R")
  ret(1) = consumeNumber(addr, i)
  Call consume(addr, i, "C")
  ret(2) = consumeNumber(addr, i)
  Call consume(addr, i, ":R")
  ret(3) = consumeNumber(addr, i)
  Call consume(addr, i, "C")
  ret(4) = consumeNumber(addr, i)
  
  parseRange = ret
End Function

'Parse a number from a string
'@param addr - The range address
'@param i - The index to parse from
'@returns - The number parsed
Private Function consumeNumber(ByRef addr As String, ByRef i As Long) As Long
  consumeNumber = 0
  While IsNumeric(Mid(addr, i, 1))
    consumeNumber = consumeNumber * 10
    consumeNumber = consumeNumber + Mid(addr, i, 1)
    i = i + 1
  Wend
End Function

  'Parse/consume a fixed string
'@param addr - The range address
'@param i - The index to parse from
'@param sConsume - The string to consume
Private Sub consume(ByRef addr As String, ByRef i As Long, ByRef sConsume As String)
  If Mid(addr, i, Len(sConsume)) <> sConsume Then Err.Raise 1, "", "Unexpected characters " & Mid(addr, i, Len(sConsume))
  i = i + Len(sConsume)
End Sub

'Get A1 style address for a row and column
'@param row - The row number
'@param col - The col number
'@returns - The address e.g. A1, B16
Private Function getA1Address(row As Long, col As Long) As String
  getA1Address = base26Encode(col) & row
End Function

'Get the column letter for a specified column index
'@param iDecimal - The column index
'@returns - The column letter, including `AA`, `AB`, ... style
Private Function base26Encode(ByVal iDecimal As Long) As String
  If iDecimal <= 0 Then Call Err.Raise(5, "base26Encode", "Argument cannot be less than 0")
  If iDecimal >= 16384 Then Call Err.Raise(5, "base26Encode", "There are only 16384 columns in a spreadsheet, thus this function is limited to this number.")
  Dim s As String: s = ""
  Do
    Dim v As Long
    v = (iDecimal - 1) Mod 26 + 1
    iDecimal = (iDecimal - v) / 26
    s = Chr(v + 64) & s
  Loop Until iDecimal = 0
  base26Encode = s
End Function