I do some work that involves translating resources for a webpage. These are all stored in a SQL Server table that looks like this (plus a few irrelevant constraints).
CREATE TABLE [dbo].[tblResources](
[lResourceID] [int] IDENTITY(1000,1) NOT NULL,
[lLocaleID] [int] NOT NULL,
[txtResourceKey] [varchar](255) NOT NULL,
[memText] [nvarchar](max) NOT NULL,
[txtLastModifiedUsername] [varchar](255) NULL,
[dtLastModifiedDate] [datetime] NULL
);
The translations come down from business people up above, almost always in an Excel spreadsheet. We've been transferring them by hand, but that takes a long time, and we also have a lot of different databases/tables for the given sites, and which table these should go into is generally poorly defined by the business people. Lastly, the keys are often already present, but not always. This is also never indicated by the business people. I've created a template excel spreadsheet with some VBA macros that will generate the SQL from a spreadsheet they give us. This is the current format of the spreadsheet that they give us, but I've added the "Generate SQL" button.
When you click the button a user form pops up to ask you which tables you want to add it to, if the change should be deployed to our staging sites as well, what the username you want logged (we track changes), and the output file name. This is powered by this VBA on the sheet
Option Explicit
Private Sub CommandButton1_Click()
GenerateSqlUserForm.Show
End Sub
And this VBA for the user form
Option Explicit
Private Sub GenerateSQLCommandButton_Click()
Sheet1.Activate
Dim localeIds(7) As String
localeIds(0) = "@US_LOCALE"
localeIds(1) = "@UK_LOCALE"
localeIds(2) = "@DE_LOCALE"
localeIds(3) = "@JP_LOCALE"
localeIds(4) = "@IT_LOCALE"
localeIds(5) = "@FR_LOCALE"
localeIds(6) = "@ES_LOCALE"
Dim fso As FileSystemObject
Set fso = New FileSystemObject
Dim stream As TextStream
Dim filename As String
filename = FileNameTextBox.Value
If Not filename Like "*.sql" Then
filename = filename & ".sql"
End If
Set stream = fso.CreateTextFile(Format("{0}\{1}", ActiveWorkbook.Path, filename), True, True)
stream.WriteLine "BEGIN TRANSACTION"
stream.WriteLine vbTab & "CREATE TABLE #Resources ("
stream.WriteLine vbTab & vbTab & "lLocaleID int NOT NULL,"
stream.WriteLine vbTab & vbTab & "txtResourceKey varchar(255) NOT NULL,"
stream.WriteLine vbTab & vbTab & "memText nvarchar(max) NOT NULL,"
stream.WriteLine vbTab & vbTab & "txtLastModifiedUsername varchar(255) NULL"
stream.WriteLine vbTab & ");"
stream.WriteLine ""
stream.WriteLine vbTab & "DECLARE " & Format("{0} int = {1}", localeIds(0), 0)
Dim i As Integer
For i = 1 To 6
stream.WriteLine vbTab & vbTab & Format(", {0} int = {1}", localeIds(i), i)
Next i
stream.WriteLine vbTab & ";"
stream.WriteLine ""
stream.WriteLine vbTab & "DECLARE @username varchar(255) = '" & UsernameTextBox.Value & "';"
Dim insertTemplate As String
insertTemplate = "INSERT INTO #Resources VALUES({0}, '{1}', N'{2}', @username);"
With Worksheets(1)
Dim row As Integer, locale As Integer, resourceText As String
row = 7
Do Until .Cells(row, 1).Value2 = ""
Dim resourceKey As String
resourceKey = .Cells(row, 1).Value2
Dim rowCells As Range
Set rowCells = Range(GetRange("B", row, "H", row))
Dim colCell As Range
locale = 0
For Each colCell In rowCells.Cells
resourceText = colCell.Value2
If Not IsNull(resourceText) And resourceText <> "" Then
stream.WriteLine vbTab & Format(insertTemplate, localeIds(locale), resourceKey, resourceText)
End If
locale = locale + 1
Next colCell
row = row + 1
Loop
End With
stream.WriteLine vbTab & "GO"
If FirstTableNameCheckBox.Value Then
AddToTextFile stream, FirstTableNameCheckBox.Caption, UseStagingCheckBox.Value
End If
If SecondTableNameCheckBox.Value Then
AddToTextFile stream, SecondTableNameCheckBox.Caption, UseStagingCheckBox.Value
End If
If ThirdTableNameCheckBox.Value Then
AddToTextFile stream, ThirdTableNameCheckBox.Caption, UseStagingCheckBox.Value
End If
If FourthTableNameCheckBox.Value Then
AddToTextFile stream, FourthTableNameCheckBox.Caption, UseStagingCheckBox.Value
End If
stream.WriteLine ""
stream.WriteLine vbTab & "DROP TABLE #Resources;"
stream.WriteLine "IF @@TRANCOUNT > 0 COMMIT TRANSACTION"
stream.WriteLine "GO"
stream.Close
GenerateSqlUserForm.Hide
End Sub
' http://stackoverflow.com/a/31730589/3076272'
Private Function Format(ParamArray arr() As Variant) As String
Dim i As Long
Dim temp As String
temp = CStr(arr(0))
For i = 1 To UBound(arr)
temp = Replace(temp, "{" & i - 1 & "}", CStr(arr(i)))
Next
Format = temp
End Function
Private Function GetRange(firstColumn, firstRow, lastColumn, lastRow) As String
GetRange = Format("{0}{1}:{2}{3}", firstColumn, firstRow, lastColumn, lastRow)
End Function
Private Sub AddToTextFile(textfile, tableName, useStaging)
AddToTextFileInternal textfile, tableName
If useStaging Then
AddToTextFileInternal textfile, tableName & "Staging"
End If
End Sub
Private Sub AddToTextFileInternal(textfile, tableName)
textfile.WriteLine ""
textfile.WriteLine vbTab & Format("USE {0};", tableName)
textfile.WriteLine vbTab & "GO"
textfile.WriteLine ""
textfile.WriteLine vbTab & "MERGE tblResources AS Target"
textfile.WriteLine vbTab & vbTab & "USING #Resources AS Source"
textfile.WriteLine vbTab & "ON Target.lLocaleID = Source.lLocaleID"
textfile.WriteLine vbTab & vbTab & "AND Target.txtResourceKey COLLATE DATABASE_DEFAULT = Source.txtResourceKey COLLATE DATABASE_DEFAULT"
textfile.WriteLine vbTab & "WHEN MATCHED"
textfile.WriteLine vbTab & vbTab & "THEN UPDATE SET"
textfile.WriteLine vbTab & vbTab & vbTab & "Target.memText = Source.memText,"
textfile.WriteLine vbTab & vbTab & vbTab & "Target.txtLastModifiedUsername = Source.txtLastModifiedUsername,"
textfile.WriteLine vbTab & vbTab & vbTab & "Target.dtLastModifiedDate = GETDATE()"
textfile.WriteLine vbTab & "WHEN NOT MATCHED BY TARGET"
textfile.WriteLine vbTab & vbTab & "THEN"
textfile.WriteLine vbTab & vbTab & vbTab & "INSERT (lLocaleID, txtResourceKey, memText, txtLastModifiedUsername, dtLastModifiedDate)"
textfile.WriteLine vbTab & vbTab & vbTab & "VALUES (Source.lLocaleID, Source.txtResourceKey, Source.memText, Source.txtLastModifiedUsername, GETDATE());"
textfile.WriteLine vbTab & "GO"
End Sub
It then generates SQL like this
BEGIN TRANSACTION
CREATE TABLE #Resources (
lLocaleID int NOT NULL,
txtResourceKey varchar(255) NOT NULL,
memText nvarchar(max) NOT NULL,
txtLastModifiedUsername varchar(255) NULL
);
DECLARE @US_LOCALE int = 0
, @UK_LOCALE int = 1
, @DE_LOCALE int = 2
, @JP_LOCALE int = 3
, @IT_LOCALE int = 4
, @FR_LOCALE int = 5
, @ES_LOCALE int = 6
;
DECLARE @username varchar(255) = 'daniel.obermiller';
INSERT INTO #Resources VALUES(@US_LOCALE, 'supercool.resourcekey', N'cool', @username);
INSERT INTO #Resources VALUES(@UK_LOCALE, 'supercool.resourcekey', N'cool', @username);
INSERT INTO #Resources VALUES(@DE_LOCALE, 'supercool.resourcekey', N'kühl', @username);
INSERT INTO #Resources VALUES(@JP_LOCALE, 'supercool.resourcekey', N'クール', @username);
INSERT INTO #Resources VALUES(@IT_LOCALE, 'supercool.resourcekey', N'fresco', @username);
INSERT INTO #Resources VALUES(@FR_LOCALE, 'supercool.resourcekey', N'frais', @username);
INSERT INTO #Resources VALUES(@ES_LOCALE, 'supercool.resourcekey', N'guay', @username);
GO
USE FirstTable;
GO
MERGE tblResources AS Target
USING #Resources AS Source
ON Target.lLocaleID = Source.lLocaleID
AND Target.txtResourceKey COLLATE DATABASE_DEFAULT = Source.txtResourceKey COLLATE DATABASE_DEFAULT
WHEN MATCHED
THEN UPDATE SET
Target.memText = Source.memText,
Target.txtLastModifiedUsername = Source.txtLastModifiedUsername,
Target.dtLastModifiedDate = GETDATE()
WHEN NOT MATCHED BY TARGET
THEN
INSERT (lLocaleID, txtResourceKey, memText, txtLastModifiedUsername, dtLastModifiedDate)
VALUES (Source.lLocaleID, Source.txtResourceKey, Source.memText, Source.txtLastModifiedUsername, GETDATE());
GO
USE FirstTableStaging;
GO
MERGE tblResources AS Target
USING #Resources AS Source
ON Target.lLocaleID = Source.lLocaleID
AND Target.txtResourceKey COLLATE DATABASE_DEFAULT = Source.txtResourceKey COLLATE DATABASE_DEFAULT
WHEN MATCHED
THEN UPDATE SET
Target.memText = Source.memText,
Target.txtLastModifiedUsername = Source.txtLastModifiedUsername,
Target.dtLastModifiedDate = GETDATE()
WHEN NOT MATCHED BY TARGET
THEN
INSERT (lLocaleID, txtResourceKey, memText, txtLastModifiedUsername, dtLastModifiedDate)
VALUES (Source.lLocaleID, Source.txtResourceKey, Source.memText, Source.txtLastModifiedUsername, GETDATE());
GO
USE SecondTable;
GO
MERGE tblResources AS Target
USING #Resources AS Source
ON Target.lLocaleID = Source.lLocaleID
AND Target.txtResourceKey COLLATE DATABASE_DEFAULT = Source.txtResourceKey COLLATE DATABASE_DEFAULT
WHEN MATCHED
THEN UPDATE SET
Target.memText = Source.memText,
Target.txtLastModifiedUsername = Source.txtLastModifiedUsername,
Target.dtLastModifiedDate = GETDATE()
WHEN NOT MATCHED BY TARGET
THEN
INSERT (lLocaleID, txtResourceKey, memText, txtLastModifiedUsername, dtLastModifiedDate)
VALUES (Source.lLocaleID, Source.txtResourceKey, Source.memText, Source.txtLastModifiedUsername, GETDATE());
GO
USE SecondTableStaging;
GO
MERGE tblResources AS Target
USING #Resources AS Source
ON Target.lLocaleID = Source.lLocaleID
AND Target.txtResourceKey COLLATE DATABASE_DEFAULT = Source.txtResourceKey COLLATE DATABASE_DEFAULT
WHEN MATCHED
THEN UPDATE SET
Target.memText = Source.memText,
Target.txtLastModifiedUsername = Source.txtLastModifiedUsername,
Target.dtLastModifiedDate = GETDATE()
WHEN NOT MATCHED BY TARGET
THEN
INSERT (lLocaleID, txtResourceKey, memText, txtLastModifiedUsername, dtLastModifiedDate)
VALUES (Source.lLocaleID, Source.txtResourceKey, Source.memText, Source.txtLastModifiedUsername, GETDATE());
GO
DROP TABLE #Resources;
IF @@TRANCOUNT > 0 COMMIT TRANSACTION
GO
I'd love feedback as to:
- How is the VBA? It looks messy to me, but I'm not very familiar with VBA. This seemed like about the best I could do.
- How is the generated SQL? I'd be happy to take suggestions to improve the readability, quality, or performance of the SQL.
Also, I've changed the names of some of the tables for business reasons - they have much better names (referring to the FirstTableNameCheckBox
, etc checkboxes).
1 Answer 1
I'll concentrate on the "pure" Excel part of your code
Use fully qualified ranges and avoid Activate/Select statements
to avoid unexpected (both form user and code itself) "sheets-jumping" breaking your code, always qualify ranges up to worksheet and (if sensible) workbook references
for example you have:
With Worksheets(1)
...
Do Until .Cells(row, 1).Value2 = ""
...
Dim rowCells As Range
Set rowCells = Range(GetRange("B", row, "H", row))
where GetRange()
returns a String
with no reference to (neither knowledge of) any worksheet
so add a dot (".") in front of "Range" call
Set rowCells = .Range(GetRange("B", row, "H", row))
Avoid Dim
statements in loops
since they consume resources uselessly, so:
Do Until .Cells(row, 1).Value2 = ""
Dim resourceKey As String
....
Dim rowCells As Range
....
Dim colCell As Range
....
Loop
should become
Dim resourceKey As String
Dim rowCells As Range
Dim colCell As Range
Do Until .Cells(row, 1).Value2 = ""
....
Loop
Use With
but keep it as short as possible
Since With object
will load the referenced object until it gets released by its corresponding End With
statement, it's best to keep it active for the strictest (though useful) time possible
So in:
With Worksheets(1)
Dim row As Integer, locale As Integer, resourceText As String
row = 7
Do Until .Cells(row, 1).Value2 = ""
resourceKey = .Cells(row, 1).Value2
....
Set rowCells = Range(GetRange("B", row, "H", row))
....
Loop
End With
Worksheets(1)
actually is exploited for referencing .Cells(row, 1)
and nothing else
then you could
take
Dim row As Integer, locale As Integer, resourceText As String
out of itset the needed looping range with
Worksheets(1)
and then release it
like follows:
Dim row As Integer, locale As Integer, resourceText As String
Dim resourceRng As Range, cell As Range
Set resourceRng = Worksheets(1).Cells(7, 1).End(xlDown).SpecialCells(XlCellType.xlCellTypeConstants) '<--| get only non blank cells with a "constant" (i.e. not a formula) content from cell "A7" downwards
If Not resourceRng Is Nothing Then '<--| check to see if you have found vaild cells
For Each cell In resourceRng
resourceKey = cell.Value2
Set rowCells = cell.Offset(, 1).Resize(, 7)
...
Next cell
End If
Use Specialcells()
method of Range
object with proper parameters to loop through non blank cells
this will avoid the execution of time consuming If
statements
for instance, this code
For Each colCell In rowCells.Cells
resourceText = colCell.Value2
If Not IsNull(resourceText) And resourceText <> "" Then
stream.WriteLine vbTab & Format(insertTemplate, localeIds(locale), resourceKey, resourceText)
End If
locale = locale + 1
Next colCell
can be rewritten to:
For Each colCell In rowCells.Cells.SpecialCells(XlCellType.xlCellTypeConstants)
stream.WriteLine vbTab & Format(insertTemplate, localeIds(colCell.Column - 2), resourceKey, colCell.Value2)
Next colCell
Divide your code into Subs/Functions
this to make it more readable and maintainable
the goal is to reach such a "main" code:
Sub main()
doThis
doThat
MakeReport
End Sub
and the same with its called Subs/Function, down to a sufficiently detailed task where you can't avoid the use of loops, ifs and so on
this will also get along a more efficient way of handling variables scope, since you'll automatically encapsulate each sub variables into them, thus freeing memory and uncluttering "higher" code
Summary
for all what above, your code could be refactored as follows
Option Explicit
Private Sub GenerateSQLCommandButton_Click()
Dim stream As TextStream
Dim localeIds(0 To 7) As String '<--| better explicitly declare lowerbound, should your macro run in a VBA environment with "Option Base 1" ruling
InitLocaleIds localeIds '<--| initialize localeIds
StartStream stream, Me.FileNameTextBox.Value '<-- start stream
WriteStream1 stream, localeIds, Me.UsernameTextBox.Value '<-- give more meaningful names to sub
WriteStream2 stream, localeIds, Worksheets(1).Cells(7, 1) '<-- give more meaningful names to sub
WriteStream3 stream '<-- give more meaningful names to sub
WriteStream4 stream '<-- give more meaningful names to sub
CloseStream stream '<-- close stream
GenerateSqlUserForm.Hide
End Sub
Sub InitLocaleIds(localeIds() As String)
localeIds(0) = "@US_LOCALE"
localeIds(1) = "@UK_LOCALE"
localeIds(2) = "@DE_LOCALE"
localeIds(3) = "@JP_LOCALE"
localeIds(4) = "@IT_LOCALE"
localeIds(5) = "@FR_LOCALE"
localeIds(6) = "@ES_LOCALE"
End Sub
Sub StartStream(stream As TextStream, ByVal filename As String)
Dim fso As FileSystemObject
Set fso = New FileSystemObject
If Not filename Like "*.sql" Then filename = filename & ".sql"
Set stream = fso.CreateTextFile(Format("{0}\{1}", ActiveWorkbook.Path, filename), True, True)
End Sub
Sub CloseStream(stream As TextStream)
stream.Close
End Sub
Sub WriteStream1(stream As TextStream, localeIds() As String, userName As String)
Dim i As Long
With stream
.WriteLine "BEGIN TRANSACTION"
.WriteLine vbTab & "CREATE TABLE #Resources ("
.WriteLine vbTab & vbTab & "lLocaleID int NOT NULL,"
.WriteLine vbTab & vbTab & "txtResourceKey varchar(255) NOT NULL,"
.WriteLine vbTab & vbTab & "memText nvarchar(max) NOT NULL,"
.WriteLine vbTab & vbTab & "txtLastModifiedUsername varchar(255) NULL"
.WriteLine vbTab & ");"
.WriteLine ""
.WriteLine vbTab & "DECLARE " & Format("{0} int = {1}", localeIds(0), 0)
For i = 1 To 6
.WriteLine vbTab & vbTab & Format(", {0} int = {1}", localeIds(i), i)
Next i
.WriteLine vbTab & ";"
.WriteLine ""
.WriteLine vbTab & "DECLARE @username varchar(255) = '" & userName & "';"
End With
End Sub
Sub WriteStream2(stream As TextStream, localeIds() As String, startRng As Range)
Dim resourceText As String, resourceKey As String, insertTemplate As String
Dim resourceRng As Range, cell As Range, rowCells As Range, colCell As Range
Set resourceRng = startRng.End(xlDown).SpecialCells(XlCellType.xlCellTypeConstants) '<--| get only non blank cells with a "constant" (i.e. not a formula) content from 'startRng' downwards
If Not resourceRng Is Nothing Then '<--| check to see if you have found vaild cells
insertTemplate = "INSERT INTO #Resources VALUES({0}, '{1}', N'{2}', @username);"
With stream
For Each cell In resourceRng
resourceKey = cell.Value2
Set rowCells = cell.Offset(, 1).Resize(, 7).SpecialCells(XlCellType.xlCellTypeConstants)
For Each colCell In rowCells
.WriteLine vbTab & Format(insertTemplate, localeIds(colCell.Column - 2), resourceKey, colCell.Value2)
Next colCell
Next cell
.WriteLine vbTab & "GO"
End With
End If
End Sub
Sub WriteStream3(stream As TextStream)
With Me
.HandleCheckBox stream, .FirstTableNameCheckBox, .UseStagingCheckBox.Value
.HandleCheckBox stream, .SecondTableNameCheckBox, .UseStagingCheckBox.Value
.HandleCheckBox stream, .ThirdTableNameCheckBox, .UseStagingCheckBox.Value
.HandleCheckBox stream, .FourthTableNameCheckBox, .UseStagingCheckBox.Value
End With
End Sub
Sub HandleCheckBox(stream As TextStream, chkBox As MSForms.CheckBox, UseStaging As Boolean)
If chkBox.Value Then
AddToTextFileInternal stream, chkBox.Caption
If UseStaging Then AddToTextFileInternal stream, chkBox.Caption & "Staging"
End If
End Sub
Sub WriteStream4(stream As TextStream)
With stream
.WriteLine ""
.WriteLine vbTab & "DROP TABLE #Resources;"
.WriteLine "IF @@TRANCOUNT > 0 COMMIT TRANSACTION"
.WriteLine "GO"
End With
End Sub
Private Sub AddToTextFileInternal(stream As TextStream, tableName As String)
With stream
.WriteLine ""
.WriteLine vbTab & Format("USE {0};", tableName)
.WriteLine vbTab & "GO"
.WriteLine ""
.WriteLine vbTab & "MERGE tblResources AS Target"
.WriteLine vbTab & vbTab & "USING #Resources AS Source"
.WriteLine vbTab & "ON Target.lLocaleID = Source.lLocaleID"
.WriteLine vbTab & vbTab & "AND Target.txtResourceKey COLLATE DATABASE_DEFAULT = Source.txtResourceKey COLLATE DATABASE_DEFAULT"
.WriteLine vbTab & "WHEN MATCHED"
.WriteLine vbTab & vbTab & "THEN UPDATE SET"
.WriteLine vbTab & vbTab & vbTab & "Target.memText = Source.memText,"
.WriteLine vbTab & vbTab & vbTab & "Target.txtLastModifiedUsername = Source.txtLastModifiedUsername,"
.WriteLine vbTab & vbTab & vbTab & "Target.dtLastModifiedDate = GETDATE()"
.WriteLine vbTab & "WHEN NOT MATCHED BY TARGET"
.WriteLine vbTab & vbTab & "THEN"
.WriteLine vbTab & vbTab & vbTab & "INSERT (lLocaleID, txtResourceKey, memText, txtLastModifiedUsername, dtLastModifiedDate)"
.WriteLine vbTab & vbTab & vbTab & "VALUES (Source.lLocaleID, Source.txtResourceKey, Source.memText, Source.txtLastModifiedUsername, GETDATE());"
.WriteLine vbTab & "GO"
End With
End Sub
' http://stackoverflow.com/a/31730589/3076272'
Private Function Format(ParamArray arr() As Variant) As String
Dim i As Long
Dim temp As String
temp = CStr(arr(0))
For i = 1 To UBound(arr)
temp = Replace(temp, "{" & i - 1 & "}", CStr(arr(i)))
Next
Format = temp
End Function