Skip to content

Instantly share code, notes, and snippets.

@tstone2077
Last active August 29, 2015 14:19
Show Gist options
  • Save tstone2077/0bff1ff28a0ffe7c7a07 to your computer and use it in GitHub Desktop.
Save tstone2077/0bff1ff28a0ffe7c7a07 to your computer and use it in GitHub Desktop.
VBA Script for Excel that updates external data AND any extra data that needs to align with that external data.
Sub UpdateQueryData(DataSyncSheetName, _
QueryTableName, _
PrimaryKeyHeaderText, _
PrimaryKeyColumn, _
FirstExtraDataColumn, _
LastExtraDataColumn, _
MainSheetName)
' Assumptions:
' * External Data has a header row
' * External Data starts on A1
' Usage:
' Call UpdateQueryData("DataSync", _
' "Table_Query_from_external_data", _
' "PKHeaderText", _
' "A", _
' "C", _
' "F", _
' "ReportSheet")
' Make sure the connection used is set to disable background refreshes
' (Data -> Connections -> "ConnectionName" -> Properties -> uncheck Enable background refresh
' DataSyncSheetName : Make sure there is a sheet witht his name
' to do scratch work (I suggest hiding the sheet)
' QueryTableName : The name of the query table used. Not sure how to find this other than
' record macro and select all on that table
' PrimaryKeyHeaderText : Assumes there is a header with your query data. This is the text
' to ignore for that header
' PrimaryKeyColumn : The column that the primary key exists in
' FirstExtraDataColumn : The first column that contains non-query data (to clear new contents)
' LastExtraDataColumn : The last column that contains non-query data (to clear new contents)
' MainSheetName : The name of the sheet holding the query table
' Make sure all the data is recorded
Sheets(DataSyncSheetName).Cells.ClearContents
Range(QueryTableName & "[#All]").Copy
Sheets(DataSyncSheetName).Range("A1").PasteSpecial _
Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveWorkbook.RefreshAll
' For each value in Column A (after the header)
For Each c In Sheets(MainSheetName).UsedRange.Columns(PrimaryKeyColumn).Cells
If Not c.Value = PrimaryKeyHeaderText Then
Set dRange = Sheets(DataSyncSheetName) _
.Range(PrimaryKeyColumn & ":" & PrimaryKeyColumn) _
.Find(c.Value)
If Not dRange Is Nothing Then
dataRow = dRange.Row
For Each d In Sheets(DataSyncSheetName).UsedRange.Rows(dataRow).Cells
If d.Column > 2 Then
Sheets(MainSheetName).Cells(c.Row, d.Column).Value = d.Value
End If
Next d
Else
Range(FirstExtraDataColumn & c.Row & ":" & LastExtraDataColumn & c.Row).ClearContents
End If
End If
Next c
Application.CutCopyMode = False
End Sub
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment