Excel macro for quickly formatting tables for Recursive Tables / Table Export script

Edit 10/20/2020: Just noticed that this code will not work for any rolls that start with 2 digits (such as 12d6). I will work on a fix for that. Currently it won't throw a code or anything, it just ignores them.

I am honestly not sure if something like this already exists because I mainly did it to practice VBA and excel macros, but since I'm fairly pleased with how it turned out I figured I would share it for anyone that mind find some use for it.

The Macro

Basically the code below can be copied and pasted into a brand new excel worksheet VBA module and work after running the first sub routine from the VBE. After that, everything works within Sheet 1. Simply enter a table name, copy a table from the Roll 20 website, press ctrl+v inside the worksheet, then press the submit button. It will convert the table date into the syntax required for entering tables into your game using the Table Export and Recursive Table scripts. Simply Copy the D column and paste into chat! 

You can also create a new sheet and copy paste multiple outputs into one column and submit them all at once. Also, it works for any table and if you want a table with the dice rolls as text instead of used for Recursive Tables there is a section in the macro that can be commented out.

I have only just started using VBA these past two weeks so some of the code may not be optimal or clean but as far as I can tell it works as I expected it too.

Example Screenshot

Things to note

This is meant to run on a brand new instance of excel, it may error with the shape creation if other shapes existed already, or if the beginning subroutine is run more than once in the same instance.

You only need to run the WorkbookFormat sub routine from the VBE, the other macros are controlled but the shortcuts or the Submit button while in the worksheet.

This works primarily from copying Roll 20 tables directly from the site; however, it can work with any table that has dice probabilities as text in the first row and the table entry in the second row using the following format:

Col 1  | Col 2

01-05 | 1d6 Wolves or 1d4 Bears

There isn't a ton of error handling in this. For instance it will throw codes if there is nothing to be pasted after pressing ctrl+v. 

It is important to clear the form using the ctrl+shift+c shortcut so you don't accidentally have leftover table data from a previous submission.

It can handle table entries with up to 3 dice rolls in them. It can be expanded fairly easily but I haven't come across any tables that have more than 3 yet.

Table Formatting

Right now, the macro reads the range of dice from column B, and the description from column C. It was designed for copy/pasting tables from the Roll20 website, so it only reads dice ranges using the format ##-## as text. For instance, to read a range of 1-9, the correct format in Column B would be 01-09. It will then return a weight of 9 to the output column for the given item.

The macro can now accommodate any numeric range. If you have any single number (e.g. 1, 27, or 19023) in the first column, the weight will return 1 as it interprets the number as a single dice roll. A range of 1-10 would return a weight of 10, etc. 

If you notice behavior that seems odd or incorrect, please don't hesitate to point it out; as I mentioned, I am not an expert with VBA or this subject by any means and am happy to improve this in any way.

Sub WorkbookFormat()
'
' WorkbookFormat Macro
'
'
Dim Format As Object
Set Format = Worksheets(1)



With Format
    .Activate
    .Cells.ClearContents
    .Cells.ClearFormats
    .Cells.NumberFormat = "@"
    Cells.Borders.LineStyle = xlLineStyleNone
    Cells.Interior.Color = RGB(256, 256, 256)
    Columns("A").ColumnWidth = 30
    Range("A4:A99999").Interior.Color = RGB(200, 200, 200)
    With Range("A1")
        .Value = "Table Name"
        .Font.Size = 14
        .HorizontalAlignment = xlCenter
        .Font.Bold = True
    End With
    With Range("A2")
        .Borders.LineStyle = xlContinuous
        .Interior.Color = RGB(230, 230, 230)
    End With
    With Range("A3")
    .RowHeight = 60
    .WrapText = True
    .VerticalAlignment = xlCenter
    .HorizontalAlignment = xlCenter
    .Value = "Enter a table name above, then click any cell and press ctrl+v to paste the table data. To clear press Ctrl+Shift+C"
    End With
    
End With

Call ButtonPlace

Application.MacroOptions Macro:="pasterecord", _
    ShortcutKey:="v"
Application.MacroOptions Macro:="Clear", _
    ShortcutKey:="C"



End Sub

Sub pasterecord()

Dim r As Integer

Worksheets(1).Activate
    Range("B1").Select
    ActiveSheet.PasteSpecial Format:="Unicode Text", Link:=False, _
    DisplayAsIcon:=False
     
End Sub
Sub Clear()

Worksheets(1).Range("B:B").ClearContents
Worksheets(1).Range("C:C").ClearContents
Worksheets(1).Range("D:D").ClearContents

End Sub
Sub DictionaryTest()
'
'Declare integers
'
Dim r As Integer
Dim i As Integer
Dim x As Integer

'
'Declare description strings
'
Dim strDescA As String
Dim strDescB As String
Dim strDescC As String
Dim strDescD As String
Dim strNewText As String
Dim strItemInput As String


'
'Declare objects for libraries: RollLen = strings for identified dice rolls, Pos = position of first character of identified dice roll
'
Dim RollLen As Object
Set RollLen = CreateObject("Scripting.Dictionary")
Dim Pos As Object
Set Pos = CreateObject("Scripting.Dictionary")

'
'Declare other variables
'
Dim strFullString As String
Dim iStringLen As Integer
Dim strTableName As String
    strTableName = Worksheets(1).Range("A2").Value
    
'Reset integers
r = 1
i = 1
x = 0

For r = 1 To WorksheetFunction.CountA(Worksheets(1).Range("C:C"))

    'Find cell content as string, find number of characters
    strFullString = Worksheets(1).Range("C" & r)
    iStringLen = Len(strFullString)
    
    'Reset values for new row
    x = 0
    strDescA = vbNullString
    strDescB = vbNullString
    strDescC = vbNullString
    strDescD = vbNullString
    
    
    For i = 1 To iStringLen
    
    'Find position of dice roll, increments on x if previous roll has been found
    If IsNumeric(Mid(strFullString, i, 1)) = True Then
        If Mid(strFullString, i + 1, 1) = "d" Then
            x = x + 1
            Pos(x) = i
            RollLen(x) = Mid(strFullString, Pos(x), WorksheetFunction.Find(" ", strFullString, Pos(x)) - Pos(x))
        End If
    End If
    
    Next i
    
    'Separate string descriptions from dice roll text; if no dice roll found in text, return original text
    If Pos(1) > 0 Then
        strDescA = Left(strFullString, Pos(1) - 1)
        If Pos(2) > 0 Then
            strDescB = Mid(strFullString, Pos(1) + Len(RollLen(1)), Pos(2) - Pos(1) - Len(RollLen(1)))
            If Pos(3) > 0 Then
                strDescC = Mid(strFullString, Pos(2) + Len(RollLen(2)), Pos(3) - Pos(2) - Len(RollLen(2)) - 1)
                If Pos(4) > 0 Then
                    strDescD = Mid(strFullString, Pos(3) + Len(RollLen(3)), Pos(4) - Pos(3) - Len(RollLen(3)) - 1)
                Else
                    strDescD = Mid(strFullString, Pos(3) + Len(RollLen(3)), 9999)
                End If
            Else
                strDescC = Mid(strFullString, Pos(2) + Len(RollLen(2)), 9999)
            End If
        Else
            strDescB = Mid(strFullString, Pos(1) + Len(RollLen(1)), 9999)
        End If
    Else
        strDescA = strFullString
    End If
        
    '
    '--Optional: adds syntax for RecursiveTables. Comment out for plain text
    '
    For i = 1 To 5

    If RollLen(i) <> "" Then
    RollLen(i) = "<%%91%%><%%91%%>" & RollLen(i) & "<%%93%%><%%93%%>"
    End If


    Next i
   '
   'End optional syntax
   '
   
   'Set new text value
    strNewText = strDescA & RollLen(1) & strDescB & RollLen(2) & strDescC & RollLen(3) & strDescD & RollLen(4)
    
    'Get item weight
    Dim iWeight As Integer
    Dim iLeft As Integer
    Dim iRight As Integer
    iLeft = 0
    iRight = 0

        
        On Error Resume Next
        Worksheets(1).Activate
        If WorksheetFunction.IfError(WorksheetFunction.Find("-", Range("B" & r)), 0) > 0 Then
            iLeft = CInt(Left(Range("B" & r), WorksheetFunction.Find("-", Range("B" & r))))
            iRight = CInt(Right(Range("B" & r), Len(Range("B" & r)) - WorksheetFunction.Find("-", Range("B" & r))))
            iWeight = iRight + iLeft + 1
        Else
            iWeight = 1
        End If
        On Error GoTo 0

    'Set input item command
    strItemInput = "!import-table-item --" & strTableName & " --" & strNewText & " --" & iWeight & " --"
    Worksheets(1).Range("D" & r).Value = strItemInput

    'Clear libraries
    Pos.RemoveAll
    RollLen.RemoveAll

Next r

    'strMessage = ""
    'MsgBox prompt:=strMessage

End Sub

Sub ButtonPlace()
'
' ButtonPlace Macro
'

'
    ActiveSheet.Shapes.AddShape(msoShapeRoundedRectangle, 9, 102, 144.75, 66.75). _
        Select
    Selection.OnAction = "DictionaryTest"
    Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = "Submit"
    With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 6). _
        ParagraphFormat
        .FirstLineIndent = 0
        .Alignment = msoAlignLeft
    End With
    With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 6).Font
        .NameComplexScript = "+mn-cs"
        .NameFarEast = "+mn-ea"
        .Fill.Visible = msoTrue
        .Fill.ForeColor.ObjectThemeColor = msoThemeColorLight1
        .Fill.ForeColor.TintAndShade = 0
        .Fill.ForeColor.Brightness = 0
        .Fill.Transparency = 0
        .Fill.Solid
        .Size = 11
        .Name = "+mn-lt"
    End With
        ActiveSheet.Shapes.Range(Array("Rectangle: Rounded Corners 1")).Select
    Selection.ShapeRange.TextFrame2.VerticalAnchor = msoAnchorMiddle
    Selection.ShapeRange.TextFrame2.TextRange.ParagraphFormat.Alignment = _
        msoAlignCenter
    Selection.ShapeRange.TextFrame2.TextRange.Font.Size = 25
    Selection.ShapeRange.TextFrame2.TextRange.Font.Bold = msoTrue
    With Selection.ShapeRange.TextFrame2.TextRange.Font
        .NameComplexScript = "Arial Nova"
        .NameFarEast = "Arial Nova"
        .Name = "Arial Nova"
    End With
    
Worksheets(1).Range("A2").Select

End Sub

I was going to point out this, but it seems your project is much more ambitious. I'll have to check it out. Does it convert the range in the first column to a weight?

I havent had a chance to look at the code, but it errors out in seevral places for me.

First this line, in ButtonPlace sub:

ActiveSheet.Shapes.Range(Array("Rectangle: Rounded Corners 1")).Select

If I comment that out, it seems to proceed appropriately and creates a form like the left pane in your screenshot, to the submit button.

Then when i paste text in, and click the submit button, it errors out due to one typo, and some variables not being properly declared. 

In the DictionaryTest sub, there's this line:

strDesD = Mid(strFullString, Pos(3) + Len(RollLen(3)), 9999)

which should be

strDescD = Mid(strFullString, Pos(3) + Len(RollLen(3)), 9999)

Also in the same Sub, the following declarations are missing, so it will error out on users with tighter security settings:

Dim strNewText As String
Dim strItemInput As String

After I made those changes, I got the table creator to run twice, but the table weight values it created were wrong. For example, if I pasted this:

1-5	1d6 Wolves or 1d4 Bears
6-10	1d6 Wolves or 1d4 Bears

it generated

 
 

  
!import-table-item -- --<%%91%%><%%91%%>1d6<%%93%%><%%93%%> Wolves or <%%91%%><%%91%%>1d4<%%93%%><%%93%%> Bears ---3
 
 

  
!import-table-item -- --<%%91%%><%%91%%>1d6<%%93%%><%%93%%> Wolves or <%%91%%><%%91%%>1d4<%%93%%><%%93%%> Bears --17
 

Note the weights of 3 and 17?

Whereas if I pasted this

5	1d6 Wolves or 1d4 Bears
10	1d6 Wolves or 1d4 Bears

it generated

 
 

  
!import-table-item -- --<%%91%%><%%91%%>1d6<%%93%%><%%93%%> Wolves or <%%91%%><%%91%%>1d4<%%93%%><%%93%%> Bears --1
 
 

  
!import-table-item -- --<%%91%%><%%91%%>1d6<%%93%%><%%93%%> Wolves or <%%91%%><%%91%%>1d4<%%93%%><%%93%%> Bears --1
 

which is wrong in a different way.

It also wasnt clear to me what format the table I'm pasting in should be in. I did try first with the table number and the table item being separated by spaces, and by columns, and neither did anything - and gave no error report so i had no idea why it wanst working.

Then i entered the above values with columns being separated by tabs, and that worked. So some more instructions on table format seem necessary.

GiGs said:

I havent had a chance to look at the code, but it errors out in seevral places for me.

First this line, in ButtonPlace sub:

ActiveSheet.Shapes.Range(Array("Rectangle: Rounded Corners 1")).Select

If I comment that out, it seems to proceed appropriately and creates a form like the left pane in your screenshot, to the submit button.

Then when i paste text in, and click the submit button, it errors out due to one typo, and some variables not being properly declared. 

In the DictionaryTest sub, there's this line:

strDesD = Mid(strFullString, Pos(3) + Len(RollLen(3)), 9999)

which should be

strDescD = Mid(strFullString, Pos(3) + Len(RollLen(3)), 9999)

Also in the same Sub, the following declarations are missing, so it will error out on users with tighter security settings:

Dim strNewText As String
Dim strItemInput As String

After I made those changes, I got the table creator to run twice, but the table weight values it created were wrong. For example, if I pasted this:

1-5	1d6 Wolves or 1d4 Bears
6-10	1d6 Wolves or 1d4 Bears

it generated

 
 

  
!import-table-item -- --<%%91%%><%%91%%>1d6<%%93%%><%%93%%> Wolves or <%%91%%><%%91%%>1d4<%%93%%><%%93%%> Bears ---3
 
 

  
!import-table-item -- --<%%91%%><%%91%%>1d6<%%93%%><%%93%%> Wolves or <%%91%%><%%91%%>1d4<%%93%%><%%93%%> Bears --17
 

Note the weights of 3 and 17?

Whereas if I pasted this

5	1d6 Wolves or 1d4 Bears
10	1d6 Wolves or 1d4 Bears

it generated

 
 

  
!import-table-item -- --<%%91%%><%%91%%>1d6<%%93%%><%%93%%> Wolves or <%%91%%><%%91%%>1d4<%%93%%><%%93%%> Bears --1
 
 

  
!import-table-item -- --<%%91%%><%%91%%>1d6<%%93%%><%%93%%> Wolves or <%%91%%><%%91%%>1d4<%%93%%><%%93%%> Bears --1
 

which is wrong in a different way.

It also wasnt clear to me what format the table I'm pasting in should be in. I did try first with the table number and the table item being separated by spaces, and by columns, and neither did anything - and gave no error report so i had no idea why it wanst working.

Then i entered the above values with columns being separated by tabs, and that worked. So some more instructions on table format seem necessary.

Thank you for the notes! I am shocked the typo never threw an error on my end but definitely going to adjust that; also, definitely kicking myself for myself declarations, sorry about that.

As for the format, I briefly described it here:

This works primarily from copying Roll 20 tables directly from the site; however, it can work with any table that has dice probabilities as text in the first row and the table entry in the second row using the following format:

Col 1  | Col 2

01-05 | 1d6 Wolves or 1d4 Bears

I can adjust the description to be a bit more specific in that the numbers, especially single digits, need to always have two characters (similar to how the websites tables print them).

For the other weights with 5 and 10, you would need to type 01-05, and 06-10 if you wanted weights of 5 for each. It is reading the 5 and 10 as singular dice rolls in your case, which is why it returns 1 as a weight. It is designed to take copy/pasted tables from the site so I didn't plan too much in the way of creating custom tables but I am happy to edit those instructions in as well.

Thank you for looking through that!

keithcurtis said:

I was going to point out this, but it seems your project is much more ambitious. I'll have to check it out. Does it convert the range in the first column to a weight?

It does; however, it works on fairly strict formatting where the ranges need to be in a format such as 01-05 instead of something like 1-5. This is because I based it on the format from the site and it actually is helpful for uniformity in the string manipulation of them. I'm sure I could make it more robust but I'd need to spend some more time with that.

This looks like it could be ported into an API as well. Interesting.

That would be even better! I don't currently have the skills/knowledge to do something like that, but I'll spend some time to see if I can learn.

The best way to learn something (for me at least) is to have something you want to do with it. Good motivation and forces you to investigate and ask questions. There are lots of coders here with extensive knowledge and willingness to help. (I have the second one of those).

Jordan C. said:

As for the format, I briefly described it here:

This works primarily from copying Roll 20 tables directly from the site; however, it can work with any table that has dice probabilities as text in the first row and the table entry in the second row using the following format:

This description confuses me, because you say its for copying from "the site", but roll20 tables dont show numbers like that. Which site are you referring to?

The bit about saying it works with dice probabilities as text in first row made me think it was referring to weights (like a roll of 1-5 is 5), which is why I tried that first.

GiGs said:

Jordan C. said:

As for the format, I briefly described it here:

This works primarily from copying Roll 20 tables directly from the site; however, it can work with any table that has dice probabilities as text in the first row and the table entry in the second row using the following format:

This description confuses me, because you say its for copying from "the site", but roll20 tables dont show numbers like that. Which site are you referring to?

The bit about saying it works with dice probabilities as text in first row made me think it was referring to weights (like a roll of 1-5 is 5), which is why I tried that first.

Oh interesting, I wasn't aware there might be a difference in format, my bad! 

Here's what I see when I look up rollable tables from the compendium 

I've since edited the original post to try and clarify that the format in the first column requires ##-## format. Sorry for the confusion.

Edit: I don't have time at the moment but I will attempt to make it compatible with other variations so if your end simply shows 1-9 I think I can cover both instances.

Aha, you were referring to the compendium. That explains it. None of the games play on roll20 have a compendium, so that didnt occur to me.

I'm in the opposite position since I only use 5e at the moment, I should have thought of other use cases. Anyway, this code should resolve all formatting issues for numbers; it accommodates #, #-#, #-##, ##-##, etc. and even handles triple digits now.

This replaces the other code directly below the declarations for getting item weight and above the set input item command. I have edited the original post to reflect the change.

iLeft = 0
iRight = 0

        
        On Error Resume Next
        Worksheets(1).Activate
        If WorksheetFunction.IfError(WorksheetFunction.Find("-", Range("B" & r)), 0) > 0 Then
            iLeft = CInt(Left(Range("B" & r), WorksheetFunction.Find("-", Range("B" & r))))
            iRight = CInt(Right(Range("B" & r), Len(Range("B" & r)) - WorksheetFunction.Find("-", Range("B" & r))))
            iWeight = iRight + iLeft + 1
        Else
            iWeight = 1
        End If
        On Error GoTo 0

How does one insert this into an excel file?

Toby,,

I tried posting this once and it won't appear for me so hopefully this one goes through:

These are instructions for 2010, but should largely be accurate for most versions I believe.

First you need to add the developer tab to the ribbon in your options. The workbook will need to be a macro-enabled workbook which will likely throw some dialogue boxes for you but its mainly just making sure you mean to do this.

From there, press Alt-F11 which will open the VBA editor. Insert a new module by right-clicking the whitespace on the navigation panel on the left-hand side then selecting insert > module.

Then copy paste the code into the blank module, select somewhere in the top function called WorkbookFormat() and press F5! 

Now you can close out of the VBA editor and save the new workbook as whatever you want without ever having to look at that editor again!

Sweet!  Thank you very much for that, this will make my life so much easier.