Tediously adding data to a table year-over-year, looking for pivot ideas..

[360]

I'm being tasked to provide a list of properties that a company owns, changing year over year, in tabular form. I have to source this info from the company's 10Ks, so its not all in one location and requires quite a bit of having to copy and paste the data (State and Property Name) into Excel for formatting before being able to add it to the table year over year. My manager wants to see it by year at the top (year of the 10K used), states on the left (the state rows increase as new properties get added but remain if properties are removed to show history over time). In the format he's looking for, with north of 10+ years of data, the table is getting enormous and I have to be extra cautious not to make any mistakes with the formatting (adding rows as necessary, etc). See example of what the table would appear like after adding year-over-year data across 3 years. The letters represent property names.. so by year 3 (2010) it shows the company still owns property A in AL, property B in AL was owned until 2009, property G has been owned since 2009, etc:

[TABLE="class: cms_table_grid, width: 500"]
<tbody>[TR]
[TD][/TD]
[TD]2008[/TD]
[TD]2009[/TD]
[TD]2010[/TD]
[/TR]
[TR]
[TD]AL[/TD]
[TD]A[/TD]
[TD]A[/TD]
[TD]A[/TD]
[/TR]
[TR]
[TD]AL[/TD]
[TD]B[/TD]
[TD]B[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]AK[/TD]
[TD]C[/TD]
[TD]C[/TD]
[TD]C[/TD]
[/TR]
[TR]
[TD]AZ[/TD]
[TD][/TD]
[TD]G[/TD]
[TD]G[/TD]
[/TR]
[TR]
[TD]CA[/TD]
[TD]D[/TD]
[TD]D[/TD]
[TD]D[/TD]
[/TR]
[TR]
[TD]CA[/TD]
[TD]E[/TD]
[TD]E[/TD]
[TD]E[/TD]
[/TR]
[TR]
[TD]FL[/TD]
[TD]F[/TD]
[TD]F[/TD]
[TD]F[/TD]
[/TR]
[TR]
[TD]GA[/TD]
[TD][/TD]
[TD][/TD]
[TD]H[/TD]
[/TR]
</tbody>[/TABLE]


I'd love to be able to paste the data I need into 3 columns (YEAR, STATE, PROPERTY) and then just pivot the entire set to show the list of properties over time as shown above but obv this isn't a pivot table's purpose (showing text in the values area).. and without macros I'm not sure there's a way to do this. I tried using PowerQuery but it displays errors for states with more than two properties using the "Do Not Aggregate" option. I feel as though there's a much easier way of accomplishing this without having to manually manicure the entire sheet to fit new yearly data each time. Anyone have any ideas? Again it HAS to be in the format of the table above.

 

[360]

Will provide further examples in a bit, but this was the first step in a few evolutions of the macros that were designed.

 

[360]

FINAL EVOLUTION

The link for the 10-Ks of an example company I used (CYH) is here, spanning from 2000-2016: https://www.sec.gov/cgi-bin/browse-edgar?action=getcompany&CIK=0001108109&type=10-k&dateb=&owner=exclude&count=40

As stated before when I was doing this manually, I had to extract the data from the hospital list within the tables of each 10-K to Excel (spanning from 2000-2016), condition/format them accordingly (eyeballing any mistakes, etc) and then paste them into my main table, year-to-year. In terms of building a macro (or macros) for this, it wouldn't be such an arduous process if the tables in the 10-K were consistent in terms of design and structure from year to year, but unfortunately as companies evolve, their reports evolve.

My friend came up with a very creative macro in order to solve this prob which has the ability to extract the data straight from the webpage itself (even provided instructions):

The code he used for the macro:

Option Explicit
-----

Public Sub ShowForm()
KDataURLandProcessform.Show
End Sub
-----

Public Function checkURLString(URLString As String)
checkURLString = URLExists(URLString)
End Function
-----

'https://www.sec.gov/Archives/edgar/data/1108109/000095014409001722/g17776e10vk.htm#105
Public Function Get10_KData(URLString As String, Optional informMe As Boolean = True) As Boolean
Dim ws10K   As Worksheet
Set ws10K = Worksheets(KDATASheet)
Dim frng    As Range
Dim fRow    As Long
Dim isOK    As Boolean
Dim fYear   As Long
Dim msgTXT  As String
isOK = False
fRow = 1
fYear = 0
isOK = False


If informMe = True Then
    If URLExists(URLString) = False Then
        URLString = vbNullString
        ws10K.Cells.Clear
        GoTo exitFunction
    End If
End If
ws10K.Visible = xlSheetVisible
ws10K.Activate
Cells.Clear




With ActiveSheet.QueryTables.Add(Connection:="URL;" & URLString _
    , Destination:=Range("$A$1"))
    .Name = "10-K Data"
    .FieldNames = True
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = False
    .BackgroundQuery = True
    .RefreshStyle = xlInsertDeleteCells
    .SavePassword = False
    .SaveData = True
    .AdjustColumnWidth = True
    .RefreshPeriod = 0
    .WebSelectionType = xlEntirePage
    .WebFormatting = xlWebFormattingNone
    .WebPreFormattedTextToColumns = True
    .WebConsecutiveDelimitersAsOne = True
    .WebSingleBlockTextImport = False
    .WebDisableDateRecognition = False
    .WebDisableRedirections = False
    .Refresh BackgroundQuery:=False
End With
With ws10K.Range("A:A")
    Set frng = .Find(What:="Form 10-K", LookIn:=xlValues, LookAT:=xlWhole, MatchCase:=False)
    If Not frng Is Nothing Then frng.Select: frng.Interior.Color = vbYellow: fRow = frng.Row: isOK = True
End With
If isOK = False Then msgTXT = "Required reference cell with 'Form 10-K' not found!": GoTo endMacro


isOK = False
With ws10K.Range("A" & fRow & ":A" & Rows.Count)
    Set frng = .Find(What:="Hospital", LookIn:=xlValues, LookAT:=xlWhole, MatchCase:=True)
    If Not frng Is Nothing Then frng.Select: frng.Interior.Color = vbYellow: fRow = frng.Row: isOK = True
End With
If isOK = False Then msgTXT = "Required reference cell with 'Hospital' not found!": GoTo endMacro


isOK = False
With ws10K.Range("A" & fRow & ":A" & Rows.Count)
    Set frng = .Find(What:="Total Licensed Beds at", LookIn:=xlValues, LookAT:=xlPart, MatchCase:=True)
    If Not frng Is Nothing Then frng.Select: frng.Interior.Color = vbYellow: fYear = CLng(Right(Trim(frng.Value), 4)): isOK = True
End With
If isOK = False Then msgTXT = "Required reference cell with 'Total Licensed Beds at' not found!": GoTo endMacro


endMacro:
If isOK = False Then
    If informMe = True Then MsgBox msgTXT, vbCritical, "INCORRECT DATA RECEIVED"
    fYear = 0
    URLString = vbNullString
    Exit Function
Else
    If informMe = True Then
        Select Case MsgBox("Data received seems correct!" & vbCrLf & vbCrLf & _
            "10-K Data retrieved for filing year:" & fYear & vbCrLf & vbCrLf & _
            "Press OK if this is correct", vbInformation + vbOKCancel + vbDefaultButton2, "CLICK 'OK' or 'Cancel'")
        Case Is = vbOK
            '*  no action maybe if modifications are required
        Case Else
            fYear = 0
            URLString = vbNullString
        End Select
    End If
End If
exitFunction:
ws10K.Range("A2").Value = fYear
ws10K.Range("E1").Value = URLString
Get10_KData = Len(Trim(ws10K.Range("E1").Value)) > 0 And ws10K.Range("A2").Value >= 2000
ws10K.Visible = xlSheetHidden
End Function
-----

Public Function getDATAYear() As Long
Dim ws10K   As Worksheet
Set ws10K = Worksheets(KDATASheet)
'ws10K.Visible = xlSheetVisible
'ws10K.Activate
Dim frng    As Range
Dim isOK    As Boolean
Dim fYear   As Long
isOK = False
If ws10K.Range("E1").Value = "" Then Exit Function
fYear = ws10K.Range("A2").Value
If fYear = 0 Then
    With ws10K.Range("A:A")
        Set frng = .Find(What:="Total Licensed Beds at", LookIn:=xlValues, LookAT:=xlPart, MatchCase:=True)
        If Not frng Is Nothing Then frng.Select: fYear = CLng(Right(frng.Value, 4)): isOK = True
    End With
End If
getDATAYear = fYear
End Function
-----

'*  code below found in both links here
'*  Link: http://stackoverflow.com/questions/25428611/vba-check-if-file-from-website-exists
'*  Link: https://www.mrexcel.com/forum/excel-questions/567315-check-if-url-exists-so-then-return-true.html


Function URLExists(url As String) As Boolean
    Application.StatusBar = "Verifying " & url
    Dim Request As Object
    Dim ff As Integer
    Dim rc As Variant


    On Error GoTo EndNow
    Set Request = CreateObject("WinHttp.WinHttpRequest.5.1")


    With Request
      .Open "GET", url, False
      .Send
      rc = .StatusText
    End With
    Set Request = Nothing
    If rc = "OK" Then URLExists = True
EndNow:
    Application.StatusBar = False
End Function

Sorry I cannot post the file in this forum, and I'm sorry for the delay in response as I have been traveling for work, but I hope this helps anyone looking for a similar solution down the line.