Reputation: 55
I currently have this table:
And I would like to categorize it by the last column so it appears as such:
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
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:
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