'Button: Import Existing Files and Power Query Merge
'(Orders, Customers, Products, Power_Query_Merged_Output)
Sub ImportExistingFilesAndPowerQueryMerge_2()
Dim wsOutput As Worksheet
Dim mCode As String
Dim folderPath As String
Dim ordersPath As String
Dim customersPath As String
Dim productsPath As String
folderPath = "C:\SalesReports\"
ordersPath = folderPath & "Orders.xlsx"
customersPath = folderPath & "Customers.xlsx"
productsPath = folderPath & "Products.xlsm"
If Dir(ordersPath) = "" Then MsgBox "Orders not found": Exit Sub
If Dir(customersPath) = "" Then MsgBox "Customers not found": Exit Sub
If Dir(productsPath) = "" Then MsgBox "Products not found": Exit Sub
On Error Resume Next
ThisWorkbook.Queries("Merged_Sales_Query").Delete
Application.DisplayAlerts = False
ThisWorkbook.Worksheets("Power_Query_Merged_Output").Delete
Application.DisplayAlerts = True
On Error GoTo 0
mCode = ""
mCode = mCode & "let" & vbCrLf
mCode = mCode & " FindHeaderTable = (SourceTable as table, HeaderName as text) as table =>" & vbCrLf
mCode = mCode & " let" & vbCrLf
mCode = mCode & " AddIndex = Table.AddIndexColumn(SourceTable, ""RowNo"", 0, 1)," & vbCrLf
mCode = mCode & " HeaderRow = Table.SelectRows(AddIndex, each List.Contains(List.Transform(Record.FieldValues(_), each Text.Trim(Text.From(_))), HeaderName)){0}[RowNo]," & vbCrLf
mCode = mCode & " SkipRows = Table.Skip(SourceTable, HeaderRow)," & vbCrLf
mCode = mCode & " Promote = Table.PromoteHeaders(SkipRows, [PromoteAllScalars=true])," & vbCrLf
mCode = mCode & " CleanHeaders = Table.TransformColumnNames(Promote, each Text.Trim(_))" & vbCrLf
mCode = mCode & " in" & vbCrLf
mCode = mCode & " CleanHeaders," & vbCrLf
mCode = mCode & " OrdersSource = Excel.Workbook(File.Contents(""" & ordersPath & """), null, true)," & vbCrLf
mCode = mCode & " OrdersRaw = Table.SelectRows(OrdersSource, each [Kind] = ""Sheet""){0}[Data]," & vbCrLf
mCode = mCode & " OrdersHeaders = FindHeaderTable(OrdersRaw, ""ProductID"")," & vbCrLf
mCode = mCode & " CustomersSource = Excel.Workbook(File.Contents(""" & customersPath & """), null, true)," & vbCrLf
mCode = mCode & " CustomersRaw = Table.SelectRows(CustomersSource, each [Kind] = ""Sheet""){0}[Data]," & vbCrLf
mCode = mCode & " CustomersHeaders = FindHeaderTable(CustomersRaw, ""CustomerID"")," & vbCrLf
mCode = mCode & " ProductsSource = Excel.Workbook(File.Contents(""" & productsPath & """), null, true)," & vbCrLf
mCode = mCode & " ProductsRaw = Table.SelectRows(ProductsSource, each [Kind] = ""Sheet""){0}[Data]," & vbCrLf
mCode = mCode & " ProductsHeaders = FindHeaderTable(ProductsRaw, ""ProductID"")," & vbCrLf
mCode = mCode & " OrdersTypes = Table.TransformColumnTypes(OrdersHeaders, {{""OrderID"", Int64.Type}, {""Date"", type date}, {""CustomerID"", type text}, {""ProductID"", type text}, {""Quantity"", Int64.Type}, {""Salesperson"", type text}})," & vbCrLf
mCode = mCode & " CustomersTypes = Table.TransformColumnTypes(CustomersHeaders, {{""CustomerID"", type text}, {""CustomerName"", type text}, {""City"", type text}})," & vbCrLf
'mCode = mCode & " ProductsTypes = Table.TransformColumnTypes(ProductsHeaders, {{""ProductID"", type text}, {""ProductName"", type text}, {""Category"", type text}, {""UnitPrice"", type number}, {""ProductImage(s)"", type any}, {""ProductImageFileName(s)"", type text}})," & vbCrLf
mCode = mCode & " ProductsTypes = Table.TransformColumnTypes(ProductsHeaders, {{""ProductID"", type text}, {""ProductName"", type text}, {""Category"", type text}, {""UnitPrice"", type number}, {""ProductImage(s)"", type any}, {""ProductImageFileName(s)"", type text}, {""ProductImageFileName(s)Desc"", type text}})," & vbCrLf
mCode = mCode & " MergeCustomers = Table.NestedJoin(OrdersTypes, {""CustomerID""}, CustomersTypes, {""CustomerID""}, ""CustomerData"", JoinKind.LeftOuter)," & vbCrLf
mCode = mCode & " ExpandCustomers = Table.ExpandTableColumn(MergeCustomers, ""CustomerData"", {""CustomerName"", ""City""}, {""CustomerName"", ""City""})," & vbCrLf
mCode = mCode & " MergeProducts = Table.NestedJoin(ExpandCustomers, {""ProductID""}, ProductsTypes, {""ProductID""}, ""ProductData"", JoinKind.LeftOuter)," & vbCrLf
' mCode = mCode & " ExpandProducts = Table.ExpandTableColumn(MergeProducts, ""ProductData"", {""ProductName"", ""Category"", ""UnitPrice"", ""ProductImage(s)"", ""ProductImageFileName(s)""}, {""ProductName"", ""Category"", ""UnitPrice"", ""ProductImage(s)"", ""ProductImageFileName(s)""})," & vbCrLf
mCode = mCode & " ExpandProducts = Table.ExpandTableColumn(MergeProducts, ""ProductData"", {""ProductName"", ""Category"", ""UnitPrice"", ""ProductImage(s)"", ""ProductImageFileName(s)"", ""ProductImageFileName(s)Desc""}, {""ProductName"", ""Category"", ""UnitPrice"", ""ProductImage(s)"", ""ProductImageFileName(s)"", ""ProductImageFileName(s)Desc""})," & vbCrLf
mCode = mCode & " AddTotalSales = Table.AddColumn(ExpandProducts, ""Total Sales"", each [Quantity] * [UnitPrice], type number)," & vbCrLf
'mCode = mCode & " ReorderedColumns = Table.ReorderColumns(AddTotalSales, {""OrderID"", ""Date"", ""CustomerID"", ""CustomerName"", ""City"", ""ProductID"", ""ProductName"", ""Category"", ""Quantity"", ""UnitPrice"", ""Total Sales"", ""Salesperson"", ""ProductImage(s)"", ""ProductImageFileName(s)""})" & vbCrLf
mCode = mCode & " ReorderedColumns = Table.ReorderColumns(AddTotalSales, {""OrderID"", ""Date"", ""CustomerID"", ""CustomerName"", ""City"", ""ProductID"", ""ProductName"", ""Category"", ""Quantity"", ""UnitPrice"", ""Total Sales"", ""Salesperson"", ""ProductImage(s)"", ""ProductImageFileName(s)"", ""ProductImageFileName(s)Desc""})" & vbCrLf
mCode = mCode & "in" & vbCrLf
mCode = mCode & " ReorderedColumns"
ThisWorkbook.Queries.Add Name:="Merged_Sales_Query", Formula:=mCode
Set wsOutput = ThisWorkbook.Worksheets.Add
wsOutput.Name = "Power_Query_Merged_Output"
With wsOutput.ListObjects.Add( _
SourceType:=0, _
Source:="OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=Merged_Sales_Query;Extended Properties=""""", _
Destination:=wsOutput.Range("A1") _
).QueryTable
.CommandType = xlCmdSql
.CommandText = Array("SELECT * FROM [Merged_Sales_Query]")
.Refresh BackgroundQuery:=False
End With
wsOutput.Columns.AutoFit
' Center vertically all cells
wsOutput.Cells.VerticalAlignment = xlCenter
' Center horizontally all cells
wsOutput.Cells.HorizontalAlignment = xlCenter
With wsOutput.ListObjects(1).ListColumns("ProductImageFileName(s)").Range
.ColumnWidth = 70
.WrapText = True
.VerticalAlignment = xlCenter
End With
With wsOutput.ListObjects(1).ListColumns("ProductImageFileName(s)Desc").Range
.ColumnWidth = 70
.WrapText = True
.VerticalAlignment = xlCenter
End With
MsgBox "Finished successfully.", vbInformation
End Sub
'Button: Add Thumbnail to Power Query Merge
'(Power_Query_Merged_Output)
Sub AddThumbnailsToMergedOutput_Flexible()
Dim ws As Worksheet
Dim tableObj As ListObject
Dim imgPathCol As Long
Dim imgThumbCol As Long
Dim modeChoice As String
Dim rowInput As String
Dim startRow As Long
Dim endRow As Long
Dim r As Long
Dim i As Long
Dim paths As Variant
Dim imagePath As String
Dim targetCell As Range
Dim pic As Shape
Dim shp As Shape
Dim thumbW As Double
Dim thumbH As Double
Dim gap As Double
Dim rowH As Double
Dim colW As Double
Dim leftPos As Double
Dim topPos As Double
Dim maxImages As Long
Dim currentImages As Long
' ==========================
' CUSTOM SIZE SETTINGS
' ==========================
thumbW = 55
thumbH = 55
gap = 4
rowH = 70
' ==========================
Set ws = ThisWorkbook.Worksheets("Power_Query_Merged_Output")
Set tableObj = ws.ListObjects(1)
imgThumbCol = tableObj.ListColumns("ProductImage(s)").Index
imgPathCol = tableObj.ListColumns("ProductImageFileName(s)").Index
modeChoice = UCase(InputBox( _
"Choose thumbnail mode:" & vbCrLf & vbCrLf & _
"ALL = all table rows" & vbCrLf & _
"RANGE = specific worksheet row range" & vbCrLf & _
"ROW = specific worksheet row", _
"Thumbnail Mode", "ALL"))
If modeChoice = "" Then Exit Sub
Select Case modeChoice
Case "ALL"
startRow = tableObj.DataBodyRange.Row
endRow = tableObj.DataBodyRange.Row + tableObj.DataBodyRange.Rows.Count - 1
Case "RANGE"
rowInput = InputBox("Enter worksheet row range, e.g. 2:10", "Select Row Range")
If rowInput = "" Then Exit Sub
If InStr(rowInput, ":") = 0 Then
MsgBox "Please enter a range like 2:10.", vbExclamation
Exit Sub
End If
startRow = CLng(Split(rowInput, ":")(0))
endRow = CLng(Split(rowInput, ":")(1))
Case "ROW"
rowInput = InputBox( _
"Enter the worksheet row number from Power_Query_Merged_Output:", _
"Select Row")
If rowInput = "" Then Exit Sub
If Not IsNumeric(rowInput) Then
MsgBox "Please enter a valid row number.", vbExclamation
Exit Sub
End If
startRow = CLng(rowInput)
endRow = startRow
Case Else
MsgBox "Invalid option. Use ALL, RANGE, or ROW.", vbExclamation
Exit Sub
End Select
maxImages = 1
For r = tableObj.DataBodyRange.Row To tableObj.DataBodyRange.Row + tableObj.DataBodyRange.Rows.Count - 1
If Trim(ws.Cells(r, tableObj.ListColumns("ProductImageFileName(s)").Range.Column).Value) <> "" Then
currentImages = UBound(Split(ws.Cells(r, tableObj.ListColumns("ProductImageFileName(s)").Range.Column).Value, ",")) + 1
If currentImages > maxImages Then
maxImages = currentImages
End If
End If
Next r
colW = ((thumbW + gap) * maxImages) / 6
tableObj.ListColumns("ProductImage(s)").Range.ColumnWidth = colW
colW = ((thumbW + gap) * maxImages) / 6
tableObj.ListColumns("ProductImage(s)").Range.ColumnWidth = colW
For r = startRow To endRow
If Not Intersect(ws.Rows(r), tableObj.DataBodyRange) Is Nothing Then
ws.Rows(r).RowHeight = rowH
For Each shp In ws.Shapes
If shp.TopLeftCell.Row = r _
And shp.TopLeftCell.Column = tableObj.ListColumns("ProductImage(s)").Range.Column Then
shp.Delete
End If
Next shp
Set targetCell = ws.Cells(r, tableObj.ListColumns("ProductImage(s)").Range.Column)
If Trim(ws.Cells(r, tableObj.ListColumns("ProductImageFileName(s)").Range.Column).Value) <> "" Then
paths = Split(ws.Cells(r, tableObj.ListColumns("ProductImageFileName(s)").Range.Column).Value, ",")
For i = LBound(paths) To UBound(paths)
imagePath = Trim(paths(i))
If Dir(imagePath) <> "" Then
leftPos = targetCell.Left + gap + ((i - LBound(paths)) * (thumbW + gap))
topPos = targetCell.Top + ((targetCell.Height - thumbH) / 2)
Set pic = ws.Shapes.AddPicture( _
Filename:=imagePath, _
LinkToFile:=msoFalse, _
SaveWithDocument:=msoTrue, _
Left:=leftPos, _
Top:=topPos, _
Width:=thumbW, _
Height:=thumbH)
pic.Placement = xlMoveAndSize
ws.Hyperlinks.Add _
Anchor:=pic, _
Address:=imagePath
End If
Next i
End If
End If
Next r
MsgBox "Thumbnail(s) added successfully.", vbInformation
End Sub