what kind of nerd are you?

importstatus.Value = "starting"
For ii = 0 To 6

Set objIE = CreateObject("InternetExplorer.Application")
With objIE
.AddressBar = False
.StatusBar = False
.MenuBar = False
.Toolbar = 0


If ii = 0 Then
importstatus.Value = "load date and weight - 1/7"
.Navigate "http://www.myfitnesspal.com/reports/results/progress/1/" & nn
ElseIf ii = 1 Then
importstatus.Value = "load calories - 2/7"
.Navigate "http://www.myfitnesspal.com/reports/results/nutrition/Calories/" & nn
ElseIf ii = 2 Then
importstatus.Value = "load carbs - 3/7"
.Navigate "http://www.myfitnesspal.com/reports/results/nutrition/Carbs/" & nn
ElseIf ii = 3 Then
importstatus.Value = "load fat - 4/7"
.Navigate "http://www.myfitnesspal.com/reports/results/nutrition/Fat/" & nn
ElseIf ii = 4 Then
importstatus.Value = "load protein - 5/7"
.Navigate "http://www.myfitnesspal.com/reports/results/nutrition/Protein/" & nn
ElseIf ii = 5 Then
importstatus.Value = "load net calories - 6/7"
.Navigate "http://www.myfitnesspal.com/reports/results/nutrition/Net Calories/" & nn
ElseIf ii = 6 Then
importstatus.Value = "load calories burned - 7/7"
.Navigate "http://www.myfitnesspal.com/reports/results/fitness/Calories Burned/" & nn
End If
.Visible = True
End With
TOSecs = 90
TimeOutTime = DateAdd("s", TOSecs, Now)
TimeOk = True

If dbg = 1 Then
MsgBox ("DEBUG 2/- Internet Explorer, waiting for load complete or 90 sec")
End If

Do While (TimeOk) 'READY STATE
DoEvents
If (Now > TimeOutTime) Then
TimeOk = False
MsgBox ("Sorry! The request timed out. Stopping now.")
Exit Sub
End If
If objIE.ReadyState = 4 Then
TimeOk = False
End If
Loop

'-wait 3 secs
Application.Wait Now + TimeValue("00:00:03")
DoEvents
If ii = 0 Then
MsgBox ("Click OK after you see the XML data in the IE Window, you may need to log in.")
End If
'start reading
st = objIE.Document.DocumentElement.innertext
objIE.Visible = False


If dbg = 1 Then
MsgBox ("DEBUG 4/ - html set to be read")
End If

istart = InStr(1, st, "row")

If dbg = 1 Then
MsgBox ("DEBUG 5/ Found first part date row at " & istart & ". Length of data string is " & Len(st))
End If

' read date only once

stlength = Len(st)

istart = InStr(istart, st, "<string>")
stwrk = Mid(st, istart + 8) 'start after the string

If ii = 0 Then
For i = 0 To n
stwrk = Trim(stwrk)
' istart = InStr(istart, st, "/a") + 3
convertstr = Mid(stwrk, 1, InStr(stwrk, "<") - 1)
ddd(i) = convertstr
' move to the next string
istart = InStr(stwrk, "<string>")
stwrk = Mid(stwrk, istart + 8)
If istart = 0 Then i = n
Next 'i
If dbg = 1 Then
MsgBox ("DEBUG 6/ Read the dates. Now at point in string: " & istart)
End If
End If

istart = InStr(istart, st, "<number>")

If dbg = 1 Then
MsgBox ("DEBUG 6A/ Read the dates. Now at point in string: " & istart)
End If

stwrk = Mid(st, istart + 8)

For i = 0 To n
gstr = Mid(stwrk, 1, InStr(stwrk, "<") - 1)
If ii = 0 Then
www(i) = Val(gstr)
ElseIf ii = 1 Then
cal(i) = Val(gstr)
ElseIf ii = 2 Then
carbs(i) = Val(gstr)
ElseIf ii = 3 Then
fat(i) = Val(gstr)
ElseIf ii = 4 Then
protein(i) = Val(gstr)
ElseIf ii = 5 Then
netcal(i) = Val(gstr)
ElseIf ii = 6 Then
burncal(i) = Val(gstr)
End If
stwrk = Mid(stwrk, InStr(stwrk, "<number>") + 8)
Next 'i

If dbg = 1 Then
MsgBox ("DEBUG 11/ Quitting IE")
End If

objIE.Quit
Set objIE = Nothing


Next 'ii

If dbg = 1 Then
MsgBox ("DEBUG 7/ Read the values. Now at point in string: " & istart & " Now going to do some index management")
End If
'reset dates
yearstr = Right(ddd(n), 4)

If dbg = 1 Then
MsgBox ("DEBUG / Set years...")
End If

For i = n To 0 Step -1
ddd(i) = Left(CStr(ddd(i)), Len(CStr(ddd(i))) - 4) & yearstr
If Left(ddd(i), 4) = "1/1/" Then
'MsgBox ddd(i)
yearstr = CStr(Int(yearstr) - 1)
End If
Next 'i

'find first value based on weight entry
'msg.Value = "Find first value..."
i = 0
While www(i) < 1 And i < n
i = i + 1
Wend

If dbg = 1 Then
MsgBox ("DEBUG 8/ Finished with index adjustments. Found fist valid value at " & i & " Going to write values in worksheet.")
End If 'reset and redim

'msg.Value = "Write values..."
k = n - i

Dim wdes, ddes, cdes, pdes, ccdes, fdes, ncdes, bcdes As Range
Dim wout(), cout(), pout(), ccout(), fout(), ncout(), bcout() As Single
Dim dout() As Date
ReDim dout(k)
ReDim wout(k)
ReDim cout(k)
ReDim pout(k)
ReDim ccout(k)
ReDim fout(k)
ReDim ncout(k)
ReDim bcout(k)

Set ddes = ws.Range("B3:B" & k + 3)
'Set ddes = ddes.Resize(k, 1)
Set wdes = ws.Range("C3:C" & k + 3)
'Set wdes = wdes.Resize(k, 1)
Set cdes = ws.Range("D3:D" & k + 3)
'Set cdes = cdes.Resize(k, 1)
Set ccdes = ws.Range("E3:E" & k + 3)
'Set ccdes = ccdes.Resize(k, 1)
Set fdes = ws.Range("F3:F" & k + 3)
'Set fdes = fdes.Resize(k, 1)
Set pdes = ws.Range("G3:G" & k + 3)
'Set pdes = pdes.Resize(k, 1)
Set ncdes = ws.Range("H3:H" & k + 3)
Set bcdes = ws.Range("I3:I" & k + 3)



Range("date_finish") = ddd(k)
Range("date_start") = ddd(0)
For j = 0 To k
wout(j) = www(n - j)
' ws.Range("C" & j + 3).Value = www(n - j)
dout(j) = ddd(n - j)
cout(j) = cal(n - j)
ccout(j) = carbs(n - j)
fout(j) = fat(n - j)
pout(j) = protein(n - j)
ncout(j) = netcal(n - j)
bcout(j) = burncal(n - j)
' ws.Range("B" & j + 3).Value = ddd(n - j)
' Msg.Value = "Write values..." & j & "/" & k
Next 'j

importstatus.Value = "posting data"
ws.Activate
wdes.Select
wdes.Value = Application.WorksheetFunction.Transpose(wout)
ddes.Select
ddes.Value = Application.WorksheetFunction.Transpose(dout)
cdes.Select
cdes.Value = Application.WorksheetFunction.Transpose(cout)
ccdes.Select
ccdes.Value = Application.WorksheetFunction.Transpose(ccout)
fdes.Select
fdes.Value = Application.WorksheetFunction.Transpose(fout)
pdes.Select
pdes.Value = Application.WorksheetFunction.Transpose(pout)
ncdes.Select
ncdes.Value = Application.WorksheetFunction.Transpose(ncout)
bcdes.Select
bcdes.Value = Application.WorksheetFunction.Transpose(bcout)
'-wait 1 secs
Application.Wait Now + TimeValue("00:00:01")

ns.Activate

If dbg = 1 Then
MsgBox ("DEBUG 9/ Finished with writing. Going to add calculations without labels")
End If

'msg.Value = "Remove alpha num..."
'Set d = ws.Range("D3:D" & 3 + n - i)
'd.Value = "=IF(C" & d.Row & "<>"""", Value(RemoveAlpha(C" & d.Row & ")),"""")"

ImportConfig

importstatus.Value = "import complete, recalc charts"
If dbg = 1 Then
MsgBox ("DEBUG 10/ Lets redo the charts!")
End If

Set_All_Graphs

ns.Activate

endMmt = Now

importstatus.Value = "**done** - import completed in :" & Format(startMmt - endMmt, "mm:ss") & " on " & Format(endMmt, "dd/mm/yyyy hh:mm:ss")
If dbg = 1 Then MsgBox ("DEBUG 12/ Done")