MEET FEATURE REQUIREMENTS, SCHEDULE, and BUDGET! Consulting available to teach your organization to apply this methodology and tools for powerful quantitative management of your business processes.
- Instruction of your staff at your site, using courseware, application example, and a functional template.
- Mentoring your key staff on an ongoing or periodic basis, on these tools or on Quantitative Program Management.
- Contracting or Employment in your organization on specific topics.
Check out my YouTube Channel: Power Operational Intelligence
Now Live! Overview, Structure, Task Data, Table Design, SQL Server, and Re-Linking now showing.
Video courses covering material on this website, and more, are presented in the playlists.
Code snippet links at YouTube Code Snippets. Twitter at @poweroperation1, #poweropi, #poweroperationalintelligence.
Subscribe on YouTube, and click the "Notification" Bell icon to be notified as content is published.
Linking Excel to a SQL DatabaseThe following VB code links data connections to a database for SQL access. To use the code, copy from this text file.
References
Public Sub updateConnections()
'Copyright (c) 2012 Richard M. Bixler, All Rights Reserved. Do not delete this copyright notice.
'Updates connections, to definitions defined in table on DataSources tab.
Dim connectionSheet As Worksheet
Dim tblConnectionConfig As ListObject
Dim thisListRow As ListRow
Dim thisConnection As WorkbookConnection
Dim strConnectionName As String, strAltPath As String, _
strPriPath As String, strTableName As String, strLinkType As String
Dim thisConnectionRowFound As Boolean
Dim thisCell As Range
Dim nameIndex As Integer, altPathIndex As Integer, _
priPathIndex As Integer, tableNameIndex As Integer, _
linkTypeIndex As Integer
Dim thisListObject As ListObject
Dim thisListObjectObject As Variant, thisSheetObject As Variant, objectRow As Variant
Dim thisSheet As Worksheet
Dim thisQuery As QueryTable
Dim thisConnectionString As String, dataSourceStringExisting As String, _
strPathSymbol As String, strThisWorkbookPath As String, strTargetFileName As String
Dim leftDelim As String, oldPath As String, dataSourceStringNew As String, _
dataSourceFileName As String
Dim dbSourceFile As String, dbTableSheet As String, sDatabase As String, _
dbTable As String, sSQL As String
Dim leftChar As Long, rightChar As Long, rightChar2 As Long
Dim thisRow As Range
Dim fsFileSystem As New FileSystemObject
Dim thisPivotObject As Variant
Dim thisPivot As PivotTable
Dim thisPivotCache As PivotCache
Dim thisWorkbook As Workbook
leftDelim = ";Data Source="
Set thisWorkbook = module1.myworkbook
Set myWorkbook = thisWorkbook
strThisWorkbookPath = thisWorkbook.Path
Set connectionSheet = thisWorkbook.Worksheets("DataSources")
Set tblConnectionConfig = connectionSheet.ListObjects("tblConnectionConfig")
'Get table column names
nameIndex = 0
priPathIndex = 0
altPathIndex = 0
tableNameIndex = 0
linkTypeIndex = 0
For Each thisCell In tblConnectionConfig.HeaderRowRange
Select Case thisCell.Value2
Case "Connection Name"
nameIndex = thisCell.Column
Case "Alternate Path"
altPathIndex = thisCell.Column
Case "Primary Path"
priPathIndex = thisCell.Column
Case "Table Name"
tableNameIndex = thisCell.Column
Case "LinkType"
linkTypeIndex = thisCell.Column
End Select
Next thisCell
For Each thisConnection In thisWorkbook.Connections
'Find listRow for this connection
thisConnectionRowFound = False
For Each thisListRow In tblConnectionConfig.ListRows
strConnectionName = ""
strAltPath = ""
strPriPath = ""
strTableName = ""
strLinkType = ""
If nameIndex > 0 Then strConnectionName = thisListRow.Range.Cells(1, nameIndex)
If altPathIndex > 0 Then strAltPath = thisListRow.Range.Cells(1, altPathIndex)
If priPathIndex > 0 Then strPriPath = thisListRow.Range.Cells(1, priPathIndex)
If tableNameIndex > 0 Then strTableName = thisListRow.Range.Cells(1, tableNameIndex)
If linkTypeIndex > 0 Then strLinkType = thisListRow.Range.Cells(1, linkTypeIndex)
If (strLinkType = "TableSource" Or strLinkType = "PivotSource") And _
strConnectionName = thisConnection.Name Then
thisConnectionRowFound = True
Application.StatusBar = "Linking " & strConnectionName
'Perform the link update
'First convert relative path to absolute
'Primary path first
sDatabase = strEvalPath(strPriPath, thisWorkbook)
If sDatabase = "" Then sDatabase = strEvalPath(strAltPath, thisWorkbook)
If sDatabase <> "" And fsFileSystem.FileExists(filespec:=sDatabase) Then
'At this point, sDatabase contains correct NEW path. Fix connection path here
'Get the existing connection string, and extract the datasource file and path
thisConnectionString = thisConnection.OLEDBConnection.Connection
leftChar = InStr(1, thisConnectionString, leftDelim, vbTextCompare) + _
Len(leftDelim)
rightChar = InStr(leftChar, thisConnectionString, ";", vbTextCompare)
dataSourceStringExisting = Mid(thisConnectionString, leftChar, rightChar - _
leftChar)
'From the existing datasource file path, separate into path and file name
rightChar2 = InStrRev(dataSourceStringExisting, "\", -1, vbTextCompare)
oldPath = Left(dataSourceStringExisting, rightChar2)
dataSourceFileName = Right(dataSourceStringExisting, _
Len(dataSourceStringExisting) - rightChar2)
'Put the new path with the datasource file name,
'and update the connection string
dataSourceStringNew = sDatabase
thisConnectionString = Replace(thisConnectionString, _
dataSourceStringExisting, dataSourceStringNew, 1, -1, vbTextCompare)
sSQL = "SELECT * FROM " & strTableName
'Update the query object with the new source file info, and refresh
thisConnection.OLEDBConnection.Connection = thisConnectionString
thisConnection.OLEDBConnection.SourceConnectionFile = dataSourceStringNew
thisConnection.OLEDBConnection.CommandType = xlCmdSql
thisConnection.OLEDBConnection.CommandText = sSQL
Else 'file does not exist
MsgBox prompt:="File does not exist: " & sDatabase, Buttons:=vbOKOnly, _
Title:="Missing File"
Application.StatusBar = ""
Exit Sub
End If 'fsFileSystem.FileExists
End If
If thisConnectionRowFound Then Exit For
Next thisListRow
Next thisConnection
thisWorkbook.RefreshAll
Application.StatusBar = ""
End Sub
Public Function strEvalPath(ByVal strPathName As String, ByVal thisWorkbook As Workbook) _
As String
'Copyright (c) 2012 Richard M. Bixler, All Rights Reserved. Do not delete this copyright notice.
Dim strPathSymbol As String, strTargetFileName As String, strThisWorkbookPath As String
strTargetFileName = ""
strEvalPath = ""
strThisWorkbookPath = thisWorkbook.Path
If strPathName <> "" Then
If Left(strPathName, 2) = ".\" Then
strPathSymbol = ".\"
strTargetFileName = Right(strPathName, Len(strPathName) - 2)
ElseIf Left(strPathName, 2) = "\\" Then
strPathSymbol = "\\"
ElseIf Left(strPathName, 3) = "..\" Then
strPathSymbol = "..\"
strTargetFileName = Right(strPathName, Len(strPathName) - 3)
Else
strPathSymbol = ""
strTargetFileName = strPathName
End If
Select Case strPathSymbol
Case "", ".\"
strEvalPath = strThisWorkbookPath & "\" & strTargetFileName
Case Else
strEvalPath = myFileSystemObject.GetAbsolutePathName(strPathName)
End Select
If strEvalPath = "" Or Not myFileSystemObject.FileExists(strEvalPath) Then strEvalPath = ""
End If 'strPathName is not null
End Function
Updating an Excel Pivot Table when its tab is selectedThe following VB code updates Excel pivot tables on a tab when the tab is selected. To use the code, copy from this text file.
References
'This code should be replicated in each worksheet containing pivot tables
Private Sub Worksheet_Activate()
Dim thisWorksheet As Worksheet
Dim thisPivot As PivotTable
Set thisWorksheet = ActiveSheet
For Each thisPivot In thisWorksheet.PivotTables
thisPivot.RefreshTable
Next thisPivot
End Sub
Linking an Excel Structured Table as Input into Microsoft AccessThis code maps a named range, accessible to link as input to MSAccess, to cover the same area as an Excel structured table. The range is created if it doesn't exist, and is updated as changes are made to the table content or dimensions. To use the code, copy from this text file. In each MSExcel tab containing a Structured Table to be made available for linking into MSAccess:
'This code should be replicated in each worksheet containing a Structured Table
' to be made available for linking into MSAccess
Private Sub Worksheet_SelectionChange(ByVal Target as Range)
Module1.TableUpdate Target:=Target
End Sub
In an Excel VBA code module named "Module1":
Public Sub TableUpdate(ByVal Target As Range)
'Copyright (c) 2015 Richard M. Bixler, All Rights Reserved. Do not delete this copyright notice.
'Keeps a range object in sync with table definition. Range object is updated each time the table
' is changed/selected.
Dim tblTarget As ListObject, thisListObject As ListObject
Dim cellChanged As Range, rngTarget As Range
Dim strTableName As String, strRangeName As String, strTblRangePrefix As String
If Target Is Nothing Then Exit Sub
Set cellChanged = Target
strTblRangePrefix = Worksheets("DataSources").Range("RangePrefix").Cells(1, 1).Value2
For Each thisListObject In cellChanged.Worksheet.ListObjects
If Not Intersect(cellChanged, thisListObject.Range) Is Nothing Then
Set tblTarget = thisListObject
strTableName = tblTarget.Name
strRangeName = strTableName
If Left(strRangeName, 3) = "tbl" Then strRangeName = Right(strRangeName, _
Len(strRangeName) - 3)
strRangeName = strTblRangePrefix & strRangeName
Set rngTarget = tblTarget.Range
rngTarget.Name = strRangeName
Exit For
End If
Next thisListObject
End Sub
|