Range variable setting empty value

76 Views Asked by At

I'm trying to pull data from a feed and loop each piece of data into A1:D1 on a worksheet labeled RawData, then move to A2:D2 for the next set of data. I've reused code from a previous VBA project I had and it works fine, this one doesn't so not sure what I'm missing.

The error I get is Application defined or object-defined error and happens at the first instance of: Sheets("RawData").range(rCurrentCell).value =

The debug.print output is correct for each xNode so the data it's setting is correct.

I think it's actually breaking when setting the value for rFirstCell and rCurrentCell. Printing these lines yields empty values.

Originally I was using ThisWorkbook.Worksheets for referencing other things and was getting an object error so switched over to using the ws object instead.

My previous code snippet for setting rFirstCell was:

'Set initial values for Range Pointers
 Set rFirstCell = Worksheets("RawData").range("A1")
 Set rCurrentCell = rFirstCell

Full Code:

Sub ReadFromAcumatica()
Dim xmlReq As ServerXMLHTTP60
Dim ws As Worksheet
Dim rFirstCell As Range 'Points to the First Cell in the row currently being updated
Dim rCurrentCell As Range 'Points the the current cell in the row being updated
Dim counter As Integer 'Counts the lines

counter = 0

'Clear Existing Data

 ThisWorkbook.Worksheets("RawData").Cells.Delete

 Set ws = ThisWorkbook.Worksheets("RawData")

 'Set initial values for Range Pointers
 Set rFirstCell = ws.Range("A1")
 Set rCurrentCell = rFirstCell

'Connect to server to pull data.
Set xmlReq = New ServerXMLHTTP60
xmlReq.Open "GET", "https://somewebsite.com", False, "username", "password"
xmlReq.send

Dim xmlStr As String
Dim XPath As String

xmlStr = xmlReq.responseText

' Create document object
Set objDom = CreateObject("Msxml2.DOMDocument.3.0")     '// Using MSXML 3.0

'/* Load XML */
objDom.LoadXML xmlStr
objDom.setProperty "SelectionNamespaces", _
"xmlns:d='http://schemas.microsoft.com/ado/2007/08/dataservices' " & _
"xmlns:m='http://schemas.microsoft.com/ado/2007/08/dataservices/metadata'"

Set xNodes = objDom.getElementsByTagName("m:properties")
    
    For Each xNode In xNodes
        If xNode.ChildNodes.Length <> 1 Then
            Debug.Print xNode.SelectSingleNode("d:OrderNbr").text, xNode.SelectSingleNode("d:InventoryID").text & _
            xNode.SelectSingleNode("d:Description").text, xNode.SelectSingleNode("d:Quantity").text, xNode.SelectSingleNode("d:RequestedOn").text

           'xNode.SelectSingleNode("d:OrderNbr").text
           
            Set rCurrentCell = rCurrentCell.Offset(0, 1) 'move current cell one column right
                Sheets("RawData").Range(rCurrentCell).Value = xNode.SelectSingleNode("d:InventoryID").text
            Set rCurrentCell = rCurrentCell.Offset(0, 1) 'move current cell one column right
                Sheets("RawData").Range(rCurrentCell).Value = xNode.SelectSingleNode("d:Description").text
            Set rCurrentCell = rCurrentCell.Offset(0, 1) 'move current cell one column right
                Sheets("RawData").Range(rCurrentCell).Value = xNode.SelectSingleNode("d:Quantity").text
            Set rCurrentCell = rCurrentCell.Offset(0, 1) 'move current cell one column right
                Sheets("RawData").Range(rCurrentCell).Value = xNode.SelectSingleNode("d:RequestedOn").text
            Set rCurrentCell = rCurrentCell.Offset(1, -4) 'move current to next line
                        
        End If
    Next

End Sub
1

There are 1 best solutions below

4
Loveb On

A much cleaner code. Don't forget to close this question.

Sub ReadFromAcumatica()
Dim xmlReq As ServerXMLHTTP60
Dim ws As Worksheet
'Dim rFirstCell As Range 'Points to the First Cell in the row currently being updated
Dim rCurrentCell As Range 'Points the the current cell in the row being updated
Dim counter As Integer 'Counts the lines

Set ws = ThisWorkbook.Worksheets("RawData")
counter = 0

'Clear Existing Data
ws.Cells.Clear

 'Set initial values for Range Pointers
 'Set rFirstCell = ws.Range("A1")
 Set rCurrentCell = ws.Range("A1")

'Connect to server to pull data.
Set xmlReq = New ServerXMLHTTP60
xmlReq.Open "GET", "https://somewebsite.com", False, "username", "password"
xmlReq.send

Dim xmlStr As String
Dim XPath As String

xmlStr = xmlReq.responseText

' Create document object
Set objDom = CreateObject("Msxml2.DOMDocument.3.0")     '// Using MSXML 3.0

'/* Load XML */
objDom.LoadXML xmlStr
objDom.SetProperty "SelectionNamespaces", _
"xmlns:d='http://schemas.microsoft.com/ado/2007/08/dataservices' " & _
"xmlns:m='http://schemas.microsoft.com/ado/2007/08/dataservices/metadata'"

Set xNodes = objDom.getElementsByTagName("m:properties")
    
    For Each xNode In xNodes
        If xNode.ChildNodes.Length <> 1 Then
            Debug.Print xNode.SelectSingleNode("d:OrderNbr").text, xNode.SelectSingleNode("d:InventoryID").text & _
            xNode.SelectSingleNode("d:Description").text, xNode.SelectSingleNode("d:Quantity").text, xNode.SelectSingleNode("d:RequestedOn").text

           'xNode.SelectSingleNode("d:OrderNbr").text
           
            rCurrentCell.Offset(0, 1) = xNode.SelectSingleNode("d:InventoryID").text
            rCurrentCell.Offset(0, 2) = xNode.SelectSingleNode("d:Description").text
            rCurrentCell.Offset(0, 3) = xNode.SelectSingleNode("d:Quantity").text
            rCurrentCell.Offset(0, 4) = xNode.SelectSingleNode("d:RequestedOn").text
            Set rCurrentCell = rCurrentCell.Offset(1, 0) 'move current to next line
        End If
    Next
End Sub