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).
This is what the VBA in the spreadsheet does:
- A custom function concatenates columns with parameters into the
Concatenated Variablescolumn. - Loops through each row in the table where
Load? = y - Sends an HTTP request to an external system using the value in the
URLcolumn. - Returns a message (created, updated, or error) and stores it in the
Messagecolumn. - Puts the current date into the
Message Timestampcolumn.
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
getColNumfunction is having one loop. You can avoid it using Range.Find method.tbl.Range.Rows(1).Cells.Countwill give you total number of columns in the ListObject.colNumURL = tbl.Range.Rows(1).Find("URL", Range("A1"), xlValues, xlWhole, xlByRows, xlNext).Columnwill give you column number of "URL" \$\endgroup\$