Earnings Exporter v0_01 Released

Finally, enough progress to be released. It works! Yay! (For me at least... haha, I haven't had any other testers, nor have tried it on any other computers.)

You can download the excel spreadsheet here. This was made on Excel 2003, I don't know how compatible with other versions this will be.

A few notes before I head to bed....

You WILL need to enable macros. You can do this by lowering your security settings on Excel. (If you get no pop-ups when you start the spreadsheet, you should be fine) You can change these settings by going on Tools > Macro > Security. I have mine on Medium so I get prompted every time the worksheet requires macros.

The "Total Hours" on the Analysis might be incorrect. I found my result pretty odd, but haven't had the chance to fix it. It should be fixed in the next release.

Feel free to make suggestions on my code. I am not a professional, and is my first time attempting VBA. Please let me know if theres a better way of doing things by posting in the comments section or e-mailing me. I would love an opportunity to learn. The code is left un-protected on the spreadsheet, and is also posted here:

Sub ChaChaGrabHistory()
Dim i As Integer
Dim MyPost As String
Dim p As Integer
Sheets("User_Info").Select
Const MyUrl As String = "http://underground.chacha.com/account/login"
Const PostUser As String = "handle="  'Change user name here
Const PostPassword As String = "&password="  'Change password here
MyPost = PostUser & Trim(Range("C4").Value) & PostPassword & Trim(Range("C5").Value)
p = Range("C6").Value

On Error GoTo Makesheet2
Sheets("Raw_Data").Select
GoTo Continue

Makesheet2:
Sheets.Add , Worksheets(Worksheets.Count)
ActiveSheet.Name = "Raw_Data"
Sheets("Raw_Data").Activate

Continue:
For i = 1 To p
If i = 1 Then
With ActiveSheet.QueryTables.Add(Connection:= _
  "URL;" & MyUrl, Destination:=Cells(1, 1))
  .PostText = MyPost
  .BackgroundQuery = True
  .TablesOnlyFromHTML = True
  .Refresh BackgroundQuery:=False
  .SaveData = True
End With
End If
  With ActiveSheet.QueryTables.Add(Connection:= _
      "URL;https://underground.chacha.com/admin/earnings/current?page=" & i, _
      Destination:=Range("A" & 1 + ((i - 1) * 15)))
      .Name = "current?page=" & i
      .FieldNames = True
      .RowNumbers = False
      .FillAdjacentFormulas = False
      .PreserveFormatting = True
      .RefreshOnFileOpen = False
      .BackgroundQuery = True
      .RefreshStyle = xlOverwriteCells
      .SavePassword = False
      .SaveData = True
      .AdjustColumnWidth = True
      .RefreshPeriod = 0
      .WebSelectionType = xlAllTables
      .WebFormatting = xlWebFormattingNone
      .WebPreFormattedTextToColumns = True
      .WebConsecutiveDelimitersAsOne = True
      .WebSingleBlockTextImport = False
      .WebDisableDateRecognition = False
      .WebDisableRedirections = False
      .Refresh BackgroundQuery:=False
  End With
Next i

Call BackupDataOnNewSheet
End Sub




Sub BackupDataOnNewSheet()

Dim szToday As String
  szToday = Format(Date, "mmm-dd-yy")
 
 

  On Error GoTo MakeSheet
  Sheets(szToday).Activate

GoTo CopyandPaste
     
MakeSheet:
  Sheets.Add , Worksheets(Worksheets.Count)
  ActiveSheet.Name = szToday
  Sheets(szToday).Activate

CopyandPaste:
  Sheets("Raw_Data").Select
  Cells.Select
  Selection.Copy

  Sheets(szToday).Activate
  Range("A1").Select
  ActiveSheet.Paste

Call Analyze_Button
End Sub


Sub SimpleAnalysisTest()
'
Dim szToday As String
  szToday = Format(Date, "mmm-dd-yy")


'
  Rows("1:1").Select
  Selection.Insert Shift:=xlDown
  Range("H1").Select
  ActiveCell.FormulaR1C1 = "Question Count"
  Range("H2").Select
  ActiveCell.FormulaR1C1 = "=IF(RC[-7]="""",0,IF(RC[-7]=""Date"",0,1))"
  Range("H2").Select
  Selection.AutoFill Destination:=Range("H2:H9999")
  Range("H2:H9999").Select
  Range("I1").Select
  ActiveCell.FormulaR1C1 = "Specialist Count"
  Range("I2").Select
  ActiveCell.FormulaR1C1 = "=IF(RC[-1]=1,IF(R[1]C[-6]=""Specialist"",1,0),0)"
  Range("I2").Select
  Selection.AutoFill Destination:=Range("I2:I9999")
  Range("I2:I9999").Select
  Range("J1").Select
  Sheets(szToday).Select
  Columns("C:C").Select
  Selection.ColumnWidth = 7.57
  Columns("E:E").ColumnWidth = 18
  Range("K4").Select
  ActiveCell.FormulaR1C1 = "Total Questions Answered"
  Range("K5").Select
  ActiveCell.FormulaR1C1 = "Percent Specialist"
  Range("K6").Select
  ActiveCell.FormulaR1C1 = "Total Earnings"
  Range("K7").Select
  ActiveCell.FormulaR1C1 = "Total Time Spent"
  Range("K8").Select
  ActiveCell.FormulaR1C1 = "Average Dime per Question"
  Range("J1").Select
  ActiveCell.FormulaR1C1 = "Abort/Abuse Count"
  Range("J2").Select
  ActiveCell.FormulaR1C1 = "=IF(RC[-2]="""",0,IF(RC[-2]=1,IF(RC[-3]=0,1,0),0))"
  Range("J2").Select
  Selection.AutoFill Destination:=Range("J2:J9999")
  Range("J2:J9999").Select
  ActiveWindow.SmallScroll Down:=-3
  Range("K9").Select
  ActiveCell.FormulaR1C1 = "Abort %"
  Range("L4").Select
  ActiveCell.FormulaR1C1 = "=SUM(C[-4])"
  Range("L5").Select
  ActiveCell.FormulaR1C1 = "=(SUM(C[-3])/R[-1]C)"
  Range("L6").Select
  ActiveCell.FormulaR1C1 = "=SUM(C[-5])"
  Range("L7").Select
  ActiveCell.FormulaR1C1 = "=SUM(C[-6])"
  Range("L8").Select
  ActiveWindow.SmallScroll Down:=-21
  Range("L8").Select
  ActiveCell.FormulaR1C1 = "=R[-2]C/R[-4]C"
  Range("L9").Select
  ActiveCell.FormulaR1C1 = "=SUM(C[-2])/R[-5]C"
  Range("K10").Select
  ActiveCell.FormulaR1C1 = "Average Time Spent Per Question"
  Range("L10").Select
  ActiveCell.FormulaR1C1 = "=AVERAGE(R[-7]C[-6]:R[9989]C[-6])"

Call Analyze
End Sub

Sub Analyze()
'
' Macro10 Macro
' Macro recorded 12/12/2008 by Richard Hung
'

Dim szToday As String
  szToday = Format(Date, "mmm-dd-yy")
  Range("K4:L10").Select
  Selection.Copy
  Sheets(szToday).Select
  Sheets.Add
  Range("C8").Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
      :=False, Transpose:=False
  Range("D13").Select
  Application.CutCopyMode = False
  Selection.NumberFormat = "0.00%"
  Range("D9").Select
  Selection.NumberFormat = "0.00%"
  Range("D10").Select
  Selection.NumberFormat = "$#,##0.00"
  Range("D12").Select
  Selection.NumberFormat = "$#,##0.00"
  Range("D14").Select
  Selection.NumberFormat = "h:mm;@"

  Columns("C:D").Select
  With Selection.Font
      .Name = "Arial"
      .Size = 18
      .Strikethrough = False
      .Superscript = False
      .Subscript = False
      .OutlineFont = False
      .Shadow = False
      .Underline = xlUnderlineStyleNone
      .ColorIndex = xlAutomatic
  End With
  Columns("C:D").EntireColumn.AutoFit
  Columns("C:D").EntireColumn.AutoFit
  Range("E10").Select
End Sub

Sub Analyze_Button()
'
' Macro15 Macro
' Macro recorded 12/12/2008 by Richard Hung
'

'
  ActiveSheet.Buttons.Add(93.75, 169.5, 105.75, 43.5).Select
  Selection.OnAction = "SimpleAnalysisTest"
  ActiveSheet.Shapes("Button 1").Select
  Selection.Characters.Text = "Analyze Data"
  With Selection.Characters(Start:=1, Length:=12).Font
      .Name = "Arial"
      .FontStyle = "Regular"
      .Size = 10
      .Strikethrough = False
      .Superscript = False
      .Subscript = False
      .OutlineFont = False
      .Shadow = False
      .Underline = xlUnderlineStyleNone
      .ColorIndex = xlAutomatic
  End With
  Range("K18").Select
End Sub

And that's it. I would appreciate any comments/criticism. I would insist that you post your problems here as well, however I can't guarantee that I'll be able to solve them.

That's it for tonight!