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

\$\endgroup\$
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
\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.