Leo Steeves
Leo Steeves

Reputation: 55

Excel - Categorize table by column

I currently have this table:

enter image description here

And I would like to categorize it by the last column so it appears as such:

enter image description here

I thought this might be doable with pivot tables or something but it doesn't seem to. I've also tried using a slicer but that doesn't give the desired effect (just hides and unhides rows). This seems like a common and simple enough thing to want to do but I can't seem to figure it out.

Edit: I don't really want to just recreate the table in the image because the table won't be properly sortable or searchable (since the 'header' rows describing the category will get sorted improperly and come up in the search), I just want it displayed similarly to the image.

Table data:

| Armor           | Cost    | AC | Strength Requirement | Stealth      | Weight | Class        |
|-----------------|---------|----|----------------------|--------------|--------|--------------|
| Padded          | 5 gp    | 11 | —                    | Disadvantage | 8 lb   | Light Armor  |
| Leather         | 10 gp   | 11 | —                    | —            | 10 lb  | Light Armor  |
| Studded leather | 45 gp   | 12 | —                    | —            | 13 lb  | Light Armor  |
| Hide            | 10 gp   | 12 | —                    | —            | 12 lb  | Medium Armor |
| Chain shirt     | 50 gp   | 13 | —                    | —            | 20 lb  | Medium Armor |
| Scale mail      | 50 gp   | 14 | —                    | Disadvantage | 45 lb  | Medium Armor |
| Breastplate     | 400 gp  | 14 | —                    | —            | 20 lb  | Medium Armor |
| Half plate      | 750 gp  | 15 | —                    | Disadvantage | 40 lb  | Medium Armor |
| Ring mail       | 30 gp   | 14 | —                    | Disadvantage | 40 lb  | Heavy Armor  |
| Chain mail      | 75 gp   | 16 | 13                   | Disadvantage | 55 lb  | Heavy Armor  |
| Splint          | 200 gp  | 17 | 15                   | Disadvantage | 60 lb  | Heavy Armor  |
| Plate           | 1500 gp | 18 | 15                   | Disadvantage | 65 lb  | Heavy Armor  |
| Shield          | 10 gp   | +2 | —                    | —            | 6 lb   | Shield       |

Upvotes: 0

Views: 334

Answers (1)

QHarr
QHarr

Reputation: 84465

You can create your own lookup as follows:

Option Explicit
Public outputRow   As Long
'VBE > Tools > references > tick MS HTML Object Library, MS XML

Public Sub Main()
    outputRow = 0
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("Output")   ''change as appropriate
    ws.Cells.ClearContents
    GetTables ws
    AddKeys ws, 1
    ws.Cells.Columns.AutoFit
    ws.Columns("A:G").NumberFormat = "@"
End Sub

Public Sub GetTables(ByVal ws As Worksheet)
    Dim http As New XMLHTTP60, html As New HTMLDocument, arr() As Variant 'XMLHTTP60     This will vary according to your Excel version

    arr = Array("Currency", "Armor", "Selling Treasure", "Armor", "Weapons", _
                "Adventuring Gear", "Tools", "Mounts and Vehicles", "Trade Goods", "Expenses")

    Dim i As Long
    For i = LBound(arr) To UBound(arr)
        DoEvents
        With http
            .Open "GET", ConstructURL(LCase$(arr(i))), False
            .send
            html.body.innerHTML = .responseText
        End With

        PrintTables html, ws
    Next i
End Sub

Public Sub PrintTables(ByVal html As HTMLDocument, ByVal ws As Worksheet)

    Dim rng As Range, tbl As HTMLTable, currentRow As Object, currentColumn As Object, i As Long, counter As Long

    For Each tbl In html.getElementsByTagName("Table")
        counter = counter + 1
        outputRow = outputRow + 1
        Set rng = ws.Range("B" & outputRow)
        rng.Offset(, -1) = "Table " & counter

        For Each currentRow In tbl.Rows
            For Each currentColumn In currentRow.Cells
                rng.Value = currentColumn.outerText
                Set rng = rng.Offset(, 1)
                i = i + 1
            Next currentColumn
            outputRow = outputRow + 1
            Set rng = rng.Offset(1, -i)
            i = 0
        Next currentRow
    Next tbl
End Sub

Public Function ConstructURL(ByVal item As String) As String
    ConstructURL = "https://dnd5e.info/equipment/" & item
End Function

Public Sub AddKeys(ByVal ws As Worksheet, Optional ByVal targetColumn As Long = 1)
    Dim loopColumn As Range, rng As Range
    Set loopColumn = ws.UsedRange.Columns(targetColumn)
    Dim cat As String

    For Each rng In loopColumn.Cells
        If InStr(1, rng.Text, "Table") > 0 Then
            cat = rng.Offset(, 1)
        End If
        If Not IsEmpty(rng.Offset(, 1)) And Not IsEmpty(rng.Offset(, 2)) Then
            If IsEmpty(rng) And Not IsEmpty(rng.Offset(, 2)) Then
                rng = cat & rng.Offset(, 1)
            End If
            If IsEmpty(rng) And IsEmpty(rng.Offset(, 2)) Then
                rng = cat & rng.Offset(, 1)
            End If
        End If
    Next rng
End Sub

Output:

Output lookup table

Note column A has an unique key that you can use to lookup an item. You will however need to know which column you are interested in, though again you could match on the column header. You can tidy this up but is already suitable for a unique lookup for a given item.

Upvotes: 1

Related Questions