7
\$\begingroup\$

Update:

This is an older version of the question/script. The new version can be found here: Part 2: Send HTTP request for each row in Excel table


I have an Excel spreadsheet where users can batch-enter records and load them into an external system (via HTTP).

enter image description here

This is what the VBA in the spreadsheet does:

  1. A custom function concatenates columns with parameters into the Concatenated Variables column.
  2. Loops through each row in the table where Load? = y
  3. Sends an HTTP request to an external system using the value in the URL column.
  4. Returns a message (created, updated, or error) and stores it in the Message column.
  5. Puts the current date into the Message Timestamp column.

Question:

How can the code be improved?


Option Explicit

Public Sub LoadRecords()

'Refreshes the Concatenated Variables column
Application.CalculateFull

Dim tbl As ListObject
Dim x As Long
Dim colNumLoad As Long
Dim colNumMessage As Long
Dim colNumURL As Long
Dim colNumTimestamp As Long
Dim response As String
Dim message As String
Dim colorIndex As Integer
 
Set tbl = ActiveSheet.ListObjects("tblData")
colNumLoad = getColNum("Load?")
colNumMessage = getColNum("Message")
colNumURL = getColNum("URL")
colNumTimestamp = getColNum("Message Timestamp")

'Clear the cell formatting in the Message column
'More info: VBA Guide To ListObject Excel Tables - 'https://www.thespreadsheetguru.com/blog/2014/6/20/the-vba-guide-to-listobject-excel-tables
tbl.ListColumns(colNumMessage).Range.Interior.colorIndex = 0

'Loop through each data body row in the table
  For x = 1 To tbl.ListRows.Count
    If UCase(tbl.ListRows(x).Range.Cells(1, colNumLoad)) = "Y" Then
        
        'Send an HTTP request to Maximo using the value in the URL column
        response = getHTTP(tbl.ListRows(x).Range.Cells(1, colNumURL))
        
        'Return a message (created, updated, or error) and store it in the Message column.
        tbl.ListRows(x).Range(1, colNumMessage).Value = response
        
        'Put the current date into the Message Timestamp column. Note: This is the Excel date, not a date from Maximo.
        tbl.ListRows(x).Range(1, colNumTimestamp).Value = Now()

        'Change background colour in the Message column for rows that were loaded. Uses the Left function to get the first word or character from the message.
        'More info: https://www.excel-easy.com/vba/examples/background-colors.html
        message = Left(tbl.ListRows(x).Range(1, colNumMessage).Value, 7)
        Select Case message
            Case "Created"
                colorIndex = 43 '(Green)
            Case "Updated"
                colorIndex = 37 '(Blue)
            Case Else
                colorIndex = 3 '(Red)
            End Select

        tbl.ListRows(x).Range(1, colNumMessage).Interior.colorIndex = colorIndex

    End If
  Next x

End Sub

'More info: https://stackoverflow.com/questions/817602/gethttp-with-excel-vba
Public Function getHTTP(ByVal url As String) As String

  With CreateObject("MSXML2.XMLHTTP")
    .Open "GET", url, False: .Send
    getHTTP = StrConv(.responseBody, vbUnicode)
  End With

End Function

Function getColNum(ColName As String) As Long

Dim tbl As ListObject
Dim x As Long
Set tbl = ActiveSheet.ListObjects("tblData")

For x = 1 To tbl.ListColumns.Count
    If tbl.ListColumns(x).Name = ColName Then
        getColNum = x
        Exit For
    End If
Next x

End Function

'Concatenate the columns that contain parameters into the Concatenated Variables column.
Function CONCATVARS(RowNum As Integer) As String

Dim tbl As ListObject
Dim x As Long
Dim varConcat As String
Set tbl = ActiveSheet.ListObjects("tblData")

For x = 1 To tbl.ListColumns.Count
    If Left(tbl.ListColumns(x).Name, 2) = "v_" Then
        If varConcat <> "" Then
            varConcat = VarConcat & "&"
        End If
        'The MID function removes the "v_" prefix from the string
        varConcat = varConcat & Mid(tbl.ListColumns(x).Name & "=" & tbl.Range.Cells(RowNum, x), 3)
    End If
Next x

CONCATVARS = varConcat

End Function
\$\endgroup\$
2
  • 1
    \$\begingroup\$ For large data, its better to reduce number of loops. The getColNum function is having one loop. You can avoid it using Range.Find method. tbl.Range.Rows(1).Cells.Count will give you total number of columns in the ListObject. colNumURL = tbl.Range.Rows(1).Find("URL", Range("A1"), xlValues, xlWhole, xlByRows, xlNext).Column will give you column number of "URL" \$\endgroup\$ – Naresh Jun 24 '20 at 15:38
  • \$\begingroup\$ Over in the VBA Rubberducking chat, @MathieuGuindon suggested I run the code through rubberduckvba.com's Inspection tool. "...will not just tell you that Option Explicit is missing, it will also explain why you want Option Explicit enabled everywhere. Many inspection ideas stemmed from questions frequently asked on Stack Overflow, and again explain what’s going on and why that might be a problem. If you’re new to VBA, Rubberduck inspections can teach you things about how VBA works, that many veterans took years to learn about!" \$\endgroup\$ – User1973 Jun 25 '20 at 13:54
3
+100
\$\begingroup\$

Constants

Use constants to make it easier to read and modify your code as names change.

Public Const TblDataName = "tblData"
Public Const TblDataLoadColumn = "Load?"
Public Const TblDataMessageColumn = "Message"
Public Const TblDataNumURLColumn = "URL"
Public Const TblDataTimestampColumn = "Message Timestamp"


Public Sub LoadRecords()
    'some code ....
    Set tbl = ActiveSheet.ListObjects(TblDataName)
    colNumLoad = getColNum(TblDataLoadColumn)
    colNumMessage = getColNum(TblDataMessageColumn)
    colNumURL = getColNum(TblDataNumURLColumn)
    colNumTimestamp = getColNum(TblDataTimestampColumn)

This setup will allow you to easily update your string references without have to review every line of code.

Avoid Using ActiveSheet

Set tbl = ActiveSheet.ListObjects("tblData")

Using ActiveSheet makes your code fragile, easy to break, and limits code reuse. It is a best practice to change your Worksheet's CodeName and reference the Worksheets by their CodeNames.

I like to add references to my ListObjects as properties of their worksheets.

Add ListObject as a Property of the Worksheet

Function getColNum can be removed

Here is the correct way to retrieve the ListColumn Index:

ListColumn Name to Index

Function CONCATVARS

Functions names should be Pascal case. I alternate between Pascal and camelCase but never all uppercase. Only constants and Enums should be all upper case (although I have been converted to using Pascal case for them also).

varConcat is very descriptive if you compare it to its context and figure out its meaning. However, you can deduce the usage of text and str without knowing its context. For such a short block of code I prefer using s. Using shorter simpler names often make the code easier to read.

Function ConcatVars(tbl As ListObject, RowNum As Integer) As String
    Dim Column As ListColumn
    Dim s As String
    
    For Each Column In tbl.ListColumns
        If Column.Name Like "v_*" Then
            s = s & IIf(Len(s) > 0, "&", "") _
                & Mid(Column.Name & "=" & Column.Range.Cells(RowNum).Value, 3)
        End If
    Next

    ConcatVars = s

End Function

ConcatVars

Refactored Code

Option Explicit
Public Const TblDataName = "tblData"
Public Const TblDataLoadColumn = "Load?"
Public Const TblDataMessageColumn = "Message"
Public Const TblDataNumURLColumn = "URL"
Public Const TblDataTimestampColumn = "Message Timestamp"

Public Sub LoadRecords()
    Rem Refreshes the Concatenated Variables column
    Application.CalculateFull
    Dim message As String, response As String
    Dim n As Long
    
    With DataSheet.GetTblData
        .ListColumns(TblDataMessageColumn).Range.Interior.colorIndex = 0
        For n = 1 To .ListRows.Count
            If UCase(.ListColumns(TblDataLoadColumn).DataBodyRange(n).Value) = "Y" Then
                response = getHTTP(.ListColumns(TblDataNumURLColumn).DataBodyRange(n).Value) 'Send an HTTP request to Maximo using the value in the URL column
                .ListColumns(TblDataMessage).DataBodyRange(n) = response

                Rem Put the current date into the Message Timestamp column. Note: This is the Excel date, not a date from Maximo.
                .ListColumns(TblDataTimestampColumn).DataBodyRange(n) = Now()
            
                With .ListColumns(TblDataMessageColumn).DataBodyRange(n)
                    message = Left(response, 7) 'Return a message (created, updated, or error) and store it in the Message column.
                    .Interior.colorIndex = Switch(message = "Created", 43, message = "Updated", 37, True, 3)
                End With
            
            End If
        Next
    End With
End Sub

Addendum

I added a sample. It shows how I would setup the project and demonstrates a couple of different techniques for working with ListObjects.

Table Demo

\$\endgroup\$
6
  • \$\begingroup\$ Regarding your ConcatVars() function: I'm struggling with the tbl As ListObject part. How would I pass in the tbl value to the function? Would I pass it in from the Excel sheet when calling the function? Right now the formula is just =concatvars(ROW()). \$\endgroup\$ – User1973 Jun 25 '20 at 18:58
  • \$\begingroup\$ In general, I'm not quite understanding how the GetTblData() function works. Would you mind explaining it a bit further? \$\endgroup\$ – User1973 Jun 25 '20 at 19:00
  • \$\begingroup\$ I think I get it now: CodeName as constant? \$\endgroup\$ – User1973 Jun 26 '20 at 13:25
  • \$\begingroup\$ @User1973 Pretty much. I mocked up a demo for you Table Demo. Thanks for accepting my answer. \$\endgroup\$ – TinMan Jun 26 '20 at 14:56
  • 1
    \$\begingroup\$ @User1973 Its personal preference. I prefer for each while working with objects. \$\endgroup\$ – TinMan Jun 26 '20 at 21:40
3
\$\begingroup\$

TinMan posted his answer while I was typing mine out but I'm pretty much done so I'm just going to answer anyway!

Use of ActiveSheet

This is probably the biggest issue with the code as is. Unless you don't know beforehand what sheet you'll be working with, you want to avoid ActiveSheet as it refers to whatever sheet the user is currently looking at, which may not even be in the same workbook! If this is intentional (say you might want to run this macro on a variety of different sheets but you never know while coding what sheets you want to run it on) then you can ignore this, but that seems unlikely since you refer to tables by name. This is an easy fix, you just change set tbl = ActiveSheet.ListObjects("tblData") to set tbl = Sheet1.ListObjects("tblData") (or whatever the codename for the sheet you're working with is).

Magic numbers

Using comments to explain random numbers in your code is good, but I prefer using constants to increase readability a tiny bit. That way you could change this

        message = Left(tbl.ListRows(x).Range(1, colNumMessage).Value, 7)
        Select Case message
            Case "Created"
                colorIndex = 43 '(Green)
            Case "Updated"
                colorIndex = 37 '(Blue)
            Case Else
                colorIndex = 3 '(Red)
            End Select

to

        message = Left(tbl.ListRows(x).Range(1, colNumMessage).Value, 7)
        Select Case message
            Case "Created"
                colorIndex = GREEN
            Case "Updated"
                colorIndex = BLUE
            Case Else
                colorIndex = RED
            End Select

and declare somewhere up top Const GREEN = 43 etc. However, I don't know what that random 7 is about. That should likely be a variable as well.

GetColNum()

I actually had a function just like this in the program I'm working on right now until I realized there's a built-in and way easier way to do it. You can just assign all of your column number variables to tbl.listcolumns("whateverColumn").Index. Then, you can just get rid of that function.

Integers

Except for a few niche cases (I think if you want to save the result of a msgbox to a variable you have to use integers), you should basically always use longs instead of integers. VBA automatically converts integers to longs behind-the-scenes so declaring as integer doesn't actually save any memory or anything (and actually adds a miniscule amount of time to your process since your data type has to be converted).

Variable Names

Code is meant to be read by people as well as machines, so you might as well make your variable names more readable! Variables like colNumLoad can become loadColumnIndex or something similar that isn't unnecessarily truncated.

Wall of Declarations

This point is kind of debated (a lot of people like to throw all their variables at the top for some reason), but I find that declaring variables close to where you use them helps readability and reduces the chance of winding up with unused variables. I didn't 100% follow through with this in my updated version below because all of the column numbers felt like properties to me

The For Loop in LoadRecords()

To me, this loop makes sense as a for each loop instead of just a for loop. (I just noticed you even say "loops through each" in your comment!) Realistically, this probably won't improve performance or anything, but I do think its a little simpler to read. Also, for half of the lines, you use .range.cells but for the other half just .range. I went with the latter because it seemed unnecessary to have both, but either way it's important to be consistent!

Also, since you have response = getHTTP() and tbl.ListRows(x).Range(1, colNumMessage).Value = response, you can cut out the response variable and just directly assign the return value of getHTTP to the range value.

ConcatVars()

Typically in VBA, function names use Pascal case. I also changed the name to ConcatenateVariables() for the reasons outlined above.

Refactored Code

Overall, this is a very good start! I hope my answer is helpful.

Option Explicit

Public Sub LoadRecords()

    Const GREEN = 43
    Const BLUE = 37
    Const RED = 3
    
    'Refreshes the Concatenated Variables column
    Application.CalculateFull

    Dim recordTable As ListObject
    Set recordTable = Sheet1.ListObjects("tblData") 'or whatever sheet you're working with
    
    Dim loadColumnIndex As Long
    Dim messageColumnIndex As Long
    Dim URLColumnIndex As Long
    Dim timestampColumnIndex As Long
    
    loadColumnIndex = recordTable.ListColumns("Load?").Index
    messageColumnIndex = recordTable.ListColumns("Message").Index
    URLColumnIndex = recordTable.ListColumns("URL").Index
    timestampColumnIndex = recordTable.ListColumns("Message Timestamp").Index
    
    'Clear the cell formatting in the Message column
    'More info: VBA Guide To ListObject Excel Tables - 'https://www.thespreadsheetguru.com/blog/2014/6/20/the-vba-guide-to-listobject-excel-tables
    recordTable.ListColumns(messageColumnIndex).Range.Interior.colorIndex = 0

    Dim currentRow As ListRow
    'Loop through each data body row in the table
    For Each currentRow In recordTable.ListRows
        If UCase(currentRow.Range(columnindex:=loadColumnIndex).Value) = "Y" Then
        
            'Send an HTTP request to Maximo using the value in the URL column,
            'Return a message (created, updated, or error) and store it in the Message column.
            currentRow.Range(columnindex:=messageColumnIndex).Value = getHTTP(currentRow.Range(columnindex:=URLColumnIndex).Value)
        
            'Put the current date into the Message Timestamp column. Note: This is the Excel date, not a date from Maximo.
            currentRow.Range(columnindex:=timestampColumnIndex).Value = Now()

            'Change background colour in the Message column for rows that were loaded. Uses the Left function to get the first word or character from the message.
            'More info: https://www.excel-easy.com/vba/examples/background-colors.html
            Dim message As String
            message = Left(currentRow.Range(columnindex:=messageColumnIndex).Value, 7)
            
            Dim colorIndex As Long
            Select Case message
            Case "Created"
                colorIndex = GREEN
            Case "Updated"
                colorIndex = BLUE
            Case Else
                colorIndex = RED
            End Select

            currentRow.Range(columnindex:=messageColumnIndex).Interior.colorIndex = colorIndex

        End If
    Next

End Sub

'More info: https://stackoverflow.com/questions/817602/gethttp-with-excel-vba
Public Function getHTTP(ByVal url As String) As String

    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", url, False: .Send
        getHTTP = StrConv(.responseBody, vbUnicode)
    End With

End Function

'Concatenate the columns that contain parameters into the Concatenated Variables column.
Function ConcatenateVariables(ByVal RowNum As Long) As String

    Const PREFIX_LENGTH = 2
    Const PREFIX_END = 3 'you can probably choose better names for these

    Dim recordTable As ListObject
    Set recordTable = Set recordTable = Sheet1.ListObjects("tblData") 'or whatever sheet you're working with

    Dim currentColumn As ListColumn
    For Each currentColumn In recordTable.ListColumns
        If Left(currentColumn.Name, PREFIX_LENGTH) = "v_" Then
            Dim result As String
            If result <> vbNullString Then
                result = result & "&"
            End If
            'The MID function removes the "v_" prefix from the string
            result = result & Mid(currentColumn.Name & "=" & currentColumn.Range(RowNum), PREFIX_END) 'prefix_length + 1 is also probably a good replacement for prefix_end
        End If
    Next

    ConcatenateVariables = result

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.