1
\$\begingroup\$

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.

Excel spreadsheet

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).

asked Jul 22, 2016 at 17:57
\$\endgroup\$

1 Answer 1

6
+50
\$\begingroup\$

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 it

  • set 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
answered Jul 23, 2016 at 11:36
\$\endgroup\$

Your Answer

Draft saved
Draft discarded

Sign up or log in

Sign up using Google
Sign up using Email and Password

Post as a guest

Required, but never shown

Post as a guest

Required, but never shown

By clicking "Post Your Answer", you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.