Public fromCol, toCol, widthCol, offsetCol, itemCol
Sub Main
' Set up expected columns to be used, best to use the provided Example_Well_Construction_Data.xlsx file or change these here if desired
Set fromCol = 1                          'starting depth values
Set toCol = 2                               'ending depth values
Set widthCol = 3                         'variable widths of construction sections
Set offsetCol = 4                         'units in similar range as widths to define where construction sections are placed
Set itemCol = 5                           'names to describe construction sections
Set itemColName = "Column E"  'matching column name as string to itemCol

Dim Grapher As Object
Set Grapher = CreateObject("Grapher.Application")
Grapher.Visible = True

' Set up the documents to use
Set dataFile = GetFilePath(, "Data Files|*.xlsx;*.xls;*.csv;*.dat", , "Open well construction data file")
Set wks = Grapher.Documents.Open(dataFile)
DoHeaderCheck(wks) 'verify the headers are as expected in the workheet, if you have different header titles for data in the right place already, comment this out
Set doc = Grapher.Documents.Add(grfPlotDoc)

Set graph = doc.Shapes.AddFloatingBarGraph(dataFile, offsetCol, fromCol, toCol)
graph.LinkTitleToObjectName = False
graph.Title.Text = "Well Construction Log"

' Set up the variable widths and any other general aesthetics
Set bars = graph.Plots.Item(1)
bars.WidthType = grfWidthColumn
bars.WidthColUnits = grfWidthColUnitsTypeAxisUnitsWidth
bars.widthCol = widthCol
bars.Line.ForeColor = grfColorBlack
bars.Fill.ForeColor = GetRandomRGB()
bars.Fill.ForeOpacity = 100

' The X axis doesn't really matter here, it's just for placing things correctly per the offsets.
' Calculate what the limits should be based off the offsets and potential variable width.
Set xAxis = graph.Axes.Item(1)
xAxis.Length = 3
xAxis.Title.Text = ""
xAxis.Visible = False
xAxis.AutoMin = False
xAxis.AutoMax = False
Set widthRange = wks.Columns(widthCol, widthCol)
Set widthStats = widthRange.Statistics()
Set offsetRange = wks.Columns(offsetCol, offsetCol)
Set offsetStats = offsetRange.Statistics()
xAxis.Min = offsetStats.Minimum - widthStats.Maximum
xAxis.Max = offsetStats.Maximum + widthStats.Maximum

Set yAxis = graph.Axes.Item(2)
yAxis.Title.Text = ""
yAxis.Descending = True
yAxis.Grid.AtMajorTicks = False

' Create a list of unique items for the schema
Set uniqueDescriptors = CreateObject("Scripting.Dictionary")
Set descriptorCol = wks.Columns(itemCol, itemCol)
For row = 2 To UBound(descriptorCol)
	Set item = descriptorCol(row, 1)
	If Not uniqueDescriptors.Exists(item) Then uniqueDescriptors.Add item, True
Next

' Now loop through the unique items and create a bar chart for each
Set tempBars = bars
For Each descriptor In uniqueDescriptors
	Dim Filters(0) As String
	Filters(0) = "[" + itemColName + "] = """ + descriptor + """"
	tempBars.Clipping.SetDataFilter(Filters)
	tempBars.Name = descriptor

	doc.Selection.DeselectAll
	tempBars.Select
	doc.Selection.Duplicate
	Set tempBars = graph.Plots.Item(graph.Plots.Count) ' continue with the newly created bars
	tempBars.Fill.ForeColor = GetRandomRGB()
Next
tempBars.Delete 'delete the last one as it's not needed, just easier this way instead of keeping track

MsgBox("To change the patterns and fills for each item, select the item in the Object Manager and adjust the Fill properties in the Property Manager.", vbOkOnly, "Well construction log complete!")

End Sub

' Helper funciton to return a random RGB value for coloring
Function GetRandomRGB()
	GetRandomRGB = RGB(Rnd() * 255, Rnd() * 255, Rnd() * 255)
End Function

' Helper function to verify the expected headers
Function DoHeaderCheck(ByRef wks As Object)
	If wks.Cells(1, fromCol).value <> "From" Then Err.Raise(1234, Description:= "Expected a column headed 'From' for column " + Str(fromCol))
	If wks.Cells(1, toCol).value <> "To" Then Err.Raise(1234, Description:= "Expected a column headed 'To' for column " + Str(toCol))
	If wks.Cells(1, widthCol).value <> "Width" Then Err.Raise(1234, Description:= "Expected a column headed 'Width' for column " + Str(widthCol))
	If wks.Cells(1, offsetCol).value <> "Offset" Then Err.Raise(1234, Description:= "Expected a column headed 'Offset' for column " + Str(offsetCol))
	If wks.Cells(1, itemCol).value <> "Item" Then Err.Raise(1234, Description:= "Expected a column headed 'Item' for column " + Str(itemCol))
End Function