Posting Data To Excel Spreadsheet

[DataCollector]

Hi,

I receive a daily Excel file with data collected from a website wher
clients register. The data is all contained in Column 1. There are
variable number of clients with 16 data elements per client, and al
the HTML tags are intact.

Using VBA, I can determine the range, how many clients are represente
and I can extract the pertinent data from the HTML tags.

My problem is posting each individual client to one row in anothe
spreadsheet and posting the next client in the row underneath th
first, etc.

I tested the code by using a named range that represented only on
client's data using a For Each...Next loop, and posting the data to on
row on another spreadsheet.

I don't know how to go back to the raw data and pick up the nex
client, post that data to the next row, and so on.

I tried using a dynamic array as:

Dim ClientArray() As Variant
Dim intClient As Integer
Dim intData As Integer
ReDim ClientArray(1 To ClientCount, 1 To 16)
For intClient = 1 To ClientCount
For intData = 1 To 16
THIS IS WHERE I DON'T KNOW WHAT TO DO
Next intData
Next intClient

Or is there a better way?

Thanks for your help

 

[Gman]

I'm not sure of the layout of your source data exactly -- but you seem
to have worked out the extracting of the data anyway.

Assuming that all data is in one A1 for client1 and A2 for client2 etc.
Something like the following should point you in one direction
(continuing your approach):

Sub ExtractDataFromActiveSheetAndWriteToNewSheet()

Dim ClientArray() As Variant
DIm ClientCount as long
Dim intClient As Integer
Dim intData As Integer
Dim shSOurce as worksheet
Dim wbDest as workbook, shDest as worksheet

set shsource = activesheet

ClientCount = shsource.usedrange.rows.count

'I would use a zerobound array but this will do fine
ReDim ClientArray(1 To ClientCount, 1 To 16)

'Go through each row (assuming one row/client)
For intClient = 1 To ClientCount

'get the data for this client - I don't know
'how you get it out, but let's pretend it's
'fixed length (20 char each) strings for simplicity
For intData = 1 to 16
ClientArray(intClient, intData) _
= MID(shsource.cells(intClient,1), _
(intData -1) * 20 + 1, 20)
Next intdata

Next intClient 'Now do the next client

'dump our retrieved data to a new workbook
'(quicker to do this in one fell swoop rather
'than line by line)

set wbdest = workbooks.add
set shdest = wbdest.sheets(1)

With shDest
.Range(.Cells(1, 1), _
.Cells(ClientCount, UBound(ClientArray, 2))) _
= ClientArray
End With

'tidy up
Set shsource=nothing
Set shdest=nothing
Set wbdest=nothing


End sub

 

[DataCollector]

Thanks, GMan...that helps a lot in posting the data. I had the mindse
that each client had to be posted before the data could be collecte
for the next client.

I'm an SQL person, so I'm not accustomed to making reports look pretty
I usually save the results of a query as a CSV file and send it t
them. This page scared the bejeesus out of them, so they sent it to m
to fix it.

Unfortunately, the extraction of the data from the HTML tags is mor
complicated. Would it be more efficient to clean up the raw dat
before the Array is created or can I call the clean up/extractio
procedure here, instead of MID....?

ClientArray(intClient, intData) _
= Mid(shSource.Cells(intClient, 1), _
(intData - 1) * 20 + 1, 20)

Here's a sample of the first few rows of the raw data. The way I fin
the start of information for a new client is the <Date> tag. I als
use the <Date> to count the number of clients. I have a separat
procedure that uses a For Each...Next loop to cycle through the ra
data collecting the 16 data elements that relate to a client. Thi
garbage repeats over and over for each client (usually around 10
separate clients).

<?xml version="1.0" encoding="UTF-8" ?>
* <!DOCTYPE EnrollOnlineClient (View Source for full doctype...)>
- <EnrollOnlineClient version="1.0">
- <Control>
- <Timestamp>
- <Date>
<Year>2005</Year>
* <Month>11</Month>
* <Day>16</Day>
</Date>
- <Time>
* <Hour>04</Hour>
* <Minute>45</Minute>
* <Second>01</Second>
* </Time>
* </Timestamp>
* </Control>

Thank you so much for your help

 

[Gman]

<<I had the mindset that each client had to be posted before the data
could be collected for the next client>>

Not necessarily a bad way to do it - if you have a thousand or so
clients though you would definitely notice a performance decrease if you
wrote row by row -- we're only talking a second maybe rather than
milliseconds.

Yes, you could write a separate procedure to clean up the data. You
could either have this return the values as an array, or have it write
directly to your master array of data. (You could even make a User
Defined Type for each client - rather than just using an array of
variants -- although this would preclude dumping data directly to Excel.)

Below I've implemented the following:

- Module level array for the data (so all procedures can write to it).
- A procedure to extract data from a passed string and update the array.
- A procedure to parse the text from a passed string between a start
and end string. fcnRetrieveStringBetweenTwoStrings

'-------------TOP OF MODULE----
Private ClientArray() As Variant
Private intClient As Integer

Sub ExtractDataFromActiveSheetAndWriteToNewSheet()

DIm ClientCount as long
Dim shSOurce as worksheet
Dim wbDest as workbook, shDest as worksheet

set shsource = activesheet

ClientCount = shsource.usedrange.rows.count

'I would use a zerobound array but this will do fine
ReDim ClientArray(1 To ClientCount, 1 To 16)

'Go through each row (assuming one row/client)
For intClient = 1 To ClientCount

'get the data for this client and add it
'to our array. Done in a separate function
'to improve code readability - but would
'sit equally well (and maybe more logically)
'here
AddClientDataToArray shsource.cells(intClient, 1)

Next intClient 'Now do the next client

'dump our retrieved data to a new workbook
'(quicker to do this in one fell swoop rather
'than line by line)

set wbdest = workbooks.add
set shdest = wbdest.sheets(1)

With shDest
.Range(.Cells(1, 1), _
.Cells(ClientCount, UBound(ClientArray, 2))) _
= ClientArray
End With

'tidy up
Set shsource=nothing
Set shdest=nothing
Set wbdest=nothing

End sub

Sub AddClientDataToArray(myData As String)

ClientArray(intClient, 1) _
= fcnRetrieveStringBetweenTwoStrings(myData, _
"<Year>", "</Year>")
ClientArray(intClient, 2) _
= fcnRetrieveStringBetweenTwoStrings(myData, _
"<MOnth>", "</Month>")
ClientArray(intClient, 3) _
= fcnRetrieveStringBetweenTwoStrings(myData, _
"<Day>", "</Day>")
'Do this for all 16 fields....

End Sub

Function fcnRetrieveStringBetweenTwoStrings(StringToParse As String, _
myStart As String, myEnd As String, _
Optional blnCleanString As Boolean) As String
'Returns blank empty if either string doesn't exist
'Trims and cleans string (i.e. white space) if blnCleanString
'is passed as true
Dim lPos1 As Long, lpos2 As Long
Dim myResult As String

'find position of the first string
lPos1 = InStr(1, StringToParse, myStart, vbTextCompare)
If lPos1 = 0 Then Exit Function

'take into account the length of the string we found
lPos1 = lPos1 + Len(myStart)

'find position of the second string (after where we found
'first string)
lpos2 = InStr(lPos1, StringToParse, myEnd, vbTextCompare)
If lPos1 = 2 Then Exit Function


myResult = Mid$(Mid$(StringToParse, 1, lpos2 - 1), lPos1)

If blnCleanString Then
fcnRetrieveStringBetweenTwoStrings _
= Application.Clean(Trim(myResult))
Else
fcnRetrieveStringBetweenTwoStrings = myResult
End If

End Function

 

[DataCollector]

GMan,

Thank you so much. With just a few modifications, this worke
beautifully. Your function is a lot cleaner than mine, too.

Thanks again...if you ever need some help with SQL, holler!

Data Collecto

 

[Gman]

Glad to be of assistance.

Be careful with casual offers of SQL assistance.... I might take you up