Output Unique Data To An Array VBA

[swiftninja]

I have been working hard learning and applying VBA using VBE in Excel 2010 for the past few weeks.

I have learned so much from all the books I've read and from all the helpful threads posted here on VBA Express forums.

However, I am having difficulty with arrays, specifically in this instance.

My Goal:
I am trying to optimize this VBA code to output data parsed from XML from the web into an array and then output the array values once to a specific range instead of outputting the data to each individual cell for each completed loop.

Here is the code:

Sub OutputData(xmlResults As MSXML2.DOMDocument, Pos As Integer)


    Dim OutputSheet As Worksheet


    OutputSheet = Worksheets("OutputSheet")
    Row# = Counter


        For Each Item In xmlResults
        
            'Grab data from these input cells and output it to OutputSheet
        '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
                OutputSheet.Cells(Row#, 1).Value = Worksheets("InputSheet").Cells(Pos, 4).Value
                OutputSheet.Cells(Row#, 2).Value = Worksheets("InputSheet").Cells(Pos, 6).Value
                OutputSheet.Cells(Row#, 8).Value = Worksheets("InputSheet").Cells(Pos, 7).Value
        '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        
                OutputSheet.Cells(Row#, 3).Value = GetVal(Item, "Product/Title")
                OutputSheet.Cells(Row#, 14).Value = GetVal(Item, "Product/Genre")
                OutputSheet.Cells(Row#, 5).Value = GetVal(Item, "Product/PartNumber")
                OutputSheet.Cells(Row#, 13).Value = GetVal(Item, "Product/Weight")
                OutputSheet.Cells(Row#, 10).Value = GetVal(Item, "Product/Length")
                OutputSheet.Cells(Row#, 11).Value = GetVal(Item, "Product/Width")
                OutputSheet.Cells(Row#, 12).Value = GetVal(Item, "Product/Height")
                OutputSheet.Cells(Row#, 4).Value = GetVal(Item, "Product/Manufacturer")
                        
                OutputSheet.Hyperlinks.Add Anchor:=OutputSheet.Cells(Row#, 16), Address:="ExampleUrl" & Query, _
                    ScreenTip:="Link To Page", _
                    TextToDisplay:="Item Page"
                
            Worksheets("Table").Cells(Row#, 25).Value = "OK"
                
        Next
        
            Worksheets("InputSheet").Cells(Pos, 8).Value = "Ok"
            
End Sub

[snb]

Sub M_snb(xmlResults As MSXML2.DOMDocument, Pos As Integer) 
    with sheets("OutputSheet") 
      For Each Item In xmlResults 
        j=j+1
        for jj=1 to 3
           .Cells(j,choose(jj, 1,2,8)).Value = sheets("InputSheet").Cells(j, choose(jj,4,6,7)).Value 
        next         

        for jj=1 to 8
          .Cells(j,choose(jj, 3,4,5,10,11,12,13,14,)).Value = GetVal(Item, "Product/" & choose(jj,"Title","Manufacturer","PartNumber","Length","Width","Height","Weight","Genre")) 
        next
     Next
  end with 
End Sub

[swiftninja]

Thanks for the quick response snb!

I gave it my best shot but I was unable to fully understand and apply your code.

After much time toiling, researching, and tinkering - the code below is the closest I have got to what I'm looking for.

Unfortunately, the code below seems slower compared to the former method and it outputs a few rows blank when it shouldn't.

I could really use someone's help, I'm not sure what I'm doing wrong to cause some rows to output as blank data, additionally, it's really slow to run compared to the former method in my original post.



The declaration below was done because there are multiple procedures involved.

''''''Declarations

Dim IdArray() As Variant
Dim OutputArray() As Variant
Dim i As Integer
Dim ProductID As String
Dim RowCnt As Long

''''''End of Declarations

Sub ProcessData
For i = 2 To UBound(IdArray)
ProductID = IdArray(i, 1)
Call RetrieveData
Next i
With Worksheets("ROI Center")
     .Range("A2", _
     .Range("U" & Counter)) = OutputArray
End With

End Sub


Sub RetrieveData

RowCnt = Worksheets("ROI Center").Range("C:C").Find("").Row
r = RowCnt

ReDim Preserve OutputArray(2 To r, 1 To 21) As Variant

For Each Item In xmlResults[/INDENT][INDENT=3]OutputArray(RowCnt, 1) = GetVal(Item, "Product/Title")         
OutputArray(RowCnt, 2) = GetVal(Item, "Product/Genre") 
OutputArray(RowCnt, 3) = GetVal(Item, "Product/PartNumber") 
OutputArray(RowCnt, 4) = GetVal(Item, "Product/Weight") 
OutputArray(RowCnt, 5) = GetVal(Item, "Product/Length") 
OutputArray(RowCnt, 6) = GetVal(Item, "Product/Width") 
OutputArray(RowCnt, 7) = GetVal(Item, "Product/Height") 
OutputArray(RowCnt, 8) = GetVal(Item, "Product/Manufacturer")

Next

End Sub

[snb]

Without any sample file(s) it's mere guessing...