So, you are providing an Excel sheet with macro functionality for free of cost. Nice try bro, keep it up.
Exactly.
At first i made it just for me to keep track of my trading but someday i just thought why not share it and here it is.
But I have not heard any file hosting in the name of xup, so fear to open your links. I like to have any screen shot for excel sheet with data and how to use it effectively if possible.
Well i just typed "one click filehoster" into google this one seemed the easiest one upload some file.
This is a screenshot of the version i am currently using (a little bit older than the version i uploaded):
https://i.imgsafe.org/f0099efe6b.pngBut if you still dont trust me you can just tinker it together yourself.
All you have to do is:
Make a new Excel-File with 3 sheets (first one = main-sheet where you put the code into, second one is where you paste the tradehistory-data and the third one is where you paste the deposithistory-data)
Add a button to sheet one with the name CommandButton1 (not the caption; caption can be whatever you want)
Paste the code from below into the main-sheet by Right-Click onto the main-sheet (down at the ribbon) -> Show Code -> Paste
Save it as
.xlsm (its important that you choose *.xlsm since you want to use a macro in this file)
Voila!
The only thing missing is the formatting but otherwise you should get the same result more or less.
The code:
Private Sub CommandButton1_Click()
ActiveSheet.Unprotect ("123")
Dim sheetId As Integer
sheetId = 1
Dim s_date As Date
If Worksheets(sheetId).Cells(4, 9).Value > 0 Then
s_date = Worksheets(sheetId).Cells(4, 9).Value
Else
s_date = "01/01/1900"
End If
Dim e_date As Date
If Worksheets(sheetId).Cells(5, 9).Value > 0 Then
e_date = Worksheets(sheetId).Cells(5, 9).Value
Else
e_date = "01/01/1900"
End If
Dim sheetTHId As Integer
sheetTHId = 2
'preset
Application.ScreenUpdating = False
Worksheets(sheetId).Cells.Columns("A:E").ClearContents
Worksheets(sheetId).Cells.Columns("A:E").Font.Bold = False
Worksheets(sheetId).Cells.Columns("A:E").Borders.LineStyle = xlNone
Worksheets(sheetId).Cells.Columns("A:E").Interior.ColorIndex = 0
Worksheets(sheetId).Cells(1, 1).Value = "Market"
Worksheets(sheetId).Cells(1, 2).Value = "Balance [BTC]"
Worksheets(sheetId).Cells(1, 3).Value = "Fees paid [BTC]"
Worksheets(sheetId).Cells(1, 4).Value = "Amount [Altcoins]"
Worksheets(sheetId).Cells(1, 5).Value = "Break-Even-Price (without fees) [BTC]"
Worksheets(sheetId).Range(Worksheets(sheetId).Cells(1, 1), Worksheets(sheetId).Cells(1, 5)).Borders(xlEdgeBottom).LineStyle = xlContinuous
'gen table based on tradehistory data
Dim r_next As Boolean
r_next = True
Dim r_next2 As Boolean
r_next2 = True
Dim r As Integer
r = 2
Dim r2 As Integer
r2 = 2
Dim market As String
market = ""
Dim r_last As Integer
r_last = 2
'Loop through rows in [tradehistory]-sheet
Do While r_next
If Worksheets(sheetTHId).Cells(r, 1).Value <> "" Then
If Worksheets(sheetTHId).Cells(r, 1).Value >= s_date And (Worksheets(sheetTHId).Cells(r, 1).Value <= e_date Or e_date = "01/01/1900") Then
r_next2 = True
r2 = 2
market = Worksheets(sheetTHId).Cells(r, 2).Value
'Loop through rows in [calc]-sheet to see if market of current row in [tradehistory]-sheet is already listed
Do While r_next2
If Worksheets(sheetId).Cells(r2, 1) <> market And Worksheets(sheetId).Cells(r2, 1) <> "" Then
r2 = r2 + 1
Else
Worksheets(sheetId).Cells(r2, 1).Value = market
r_next2 = False
End If
If r_last < r2 Then
r_last = r2
End If
Loop
If Worksheets(sheetTHId).Cells(r, 4) = "Buy" Then
Worksheets(sheetId).Cells(r2, 2).Value = Worksheets(sheetId).Cells(r2, 2).Value - Worksheets(sheetTHId).Cells(r, 7).Value
Worksheets(sheetId).Cells(r2, 3).Value = Worksheets(sheetId).Cells(r2, 3).Value + 0
End If
If Worksheets(sheetTHId).Cells(r, 4) = "Sell" Then
Worksheets(sheetId).Cells(r2, 2).Value = Worksheets(sheetId).Cells(r2, 2).Value + Worksheets(sheetTHId).Cells(r, 10).Value
Worksheets(sheetId).Cells(r2, 3).Value = Worksheets(sheetId).Cells(r2, 3).Value + (Worksheets(sheetTHId).Cells(r, 7).Value - Worksheets(sheetTHId).Cells(r, 10).Value) + 0
End If
Worksheets(sheetId).Cells(r2, 4).Formula = "=SUMIF(" & Worksheets(sheetTHId).Name & "!B:B," & Worksheets(sheetId).Name & "!A" & r2 & "," & Worksheets(sheetTHId).Name & "!K:K)"
Worksheets(sheetId).Cells(r2, 5).FormulaR1C1 = "=IF(RC[-1]>0.001, RC[-3] / RC[-1], ""."")"
'hatching for readiablity
If r2 Mod 2 = 0 Then
Range(Worksheets(sheetId).Cells(r2, 1), Worksheets(sheetId).Cells(r2, 5)).Interior.ColorIndex = 15
End If
End If
r = r + 1
Else
r_next = False
End If
Loop
'correction based on deposithistory data
sheetTHId = 3
r_next2 = True
r2 = 2
Do While r_next2
If Worksheets(sheetTHId).Cells(r2, 1).Value <> "" Then
If Worksheets(sheetTHId).Cells(r2, 1).Value >= s_date And (Worksheets(sheetTHId).Cells(r2, 1).Value <= e_date Or e_date = "01/01/1900") Then
If Worksheets(sheetTHId).Cells(r2, 2).Value <> "BTC" Then
r_next = True
r = 2
Do While r_next
If Worksheets(sheetId).Cells(r, 1).Value <> "" Then
If Worksheets(sheetTHId).Cells(r2, 2).Value = Left(Worksheets(sheetId).Cells(r, 1).Value, Len(Worksheets(sheetTHId).Cells(r2, 2).Value)) Then
Worksheets(sheetId).Cells(r, 4).Formula = Worksheets(sheetId).Cells(r, 4).Formula & "+" & Worksheets(sheetTHId).Cells(r2, 3).Value
End If
r = r + 1
Else
r_next = False
End If
Loop
End If
End If
r2 = r2 + 1
Else
r_next2 = False
End If
Loop
'finish with sum row
Rows(r_last + 1).EntireRow.Font.Bold = True
Worksheets(sheetId).Cells(r_last + 1, 1).Value = "SUM:"
Worksheets(sheetId).Cells(r_last + 1, 2).Formula = "=SUM(B2:B" & r_last & ")"
Worksheets(sheetId).Cells(r_last + 1, 3).Formula = "=SUM(C2:C" & r_last & ")*(-1)"
Worksheets(sheetId).Range(Worksheets(sheetId).Cells(r_last + 1, 1), Worksheets(sheetId).Cells(r_last + 1, 5)).Borders(xlEdgeTop).LineStyle = xlContinuous
Application.ScreenUpdating = True
ActiveSheet.Protect ("123")
End Sub
greetings!
