PDA

View Full Version : Output Unique Data To An Array VBA



swiftninja
10-13-2014, 07:00 AM
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
10-13-2014, 07:37 AM
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
10-14-2014, 12:50 AM
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
10-14-2014, 01:59 AM
Without any sample file(s) it's mere guessing...