Extract information out of a cell.

Ramballah · May 26, 2019

Well hello everyone...
I have posted this before, but since i got no replies or help, i thought i would repost it and ask it a bit differently or something.
So i have an sheet where i want to keep track of my coinflips.. But to make life easy i want to just write down simple things and then excel has to extract the information from that cell
into my charts
in the end it has to look something like this:

		Number	Winstreak	Amount BET	Whats bet on	Win/Lose	What the coin landed on	Profits	Person
50 t	lose	me	1	-	50	Tails	Lose	Heads	$ -50	Me
5 h	win	shee	2	-	5	Heads	Win	Heads	-	Shee
50 t	win	me	3	1	50	Tails	Win	Tails	$ 50	Me
50 t	win	me	4	2	50	Tails	Win	Tails	$ 50	Me
600 h	win	me	5	3	600	Heads	Win	Heads	$ 600	Me
50 t	lose	me	6	-	50	Tails	Lose	Heads	$ -50	Me
250 t	win	me	7	1	250	Tails	Win	Tails	$ 250	Me
500 h	lose	me	8	-	500	Heads	Lose	Tails	$ -500	Me
500 h	lose	me	9	-	500	Heads	Lose	Tails	$ -500	Me
1000 h	lose	me	10	-	1000	Heads	Lose	Tails	$ -1,000	Me
1500 h	lose	me	11	-	1500	Heads	Lose	Tails	$ -1,500	Me
319 h	win	me	12	1	319	Heads	Win	Heads	$ 319	Me
100 t	win	me	13	2	100	Tails	Win	Tails	$ 100	Me
100 t	win	me	14	3	100	Tails	Win	Tails	$ 100	Me
200 h	win	me	15	4	200	Heads	Win	Heads	$ 200	Me
200 t	win	me	16	5	200	Tails	Win	Tails	$ 200	Me
100 h	win	me	17	6	100	Heads	Win	Heads	$ 100	Me
73 t	win	me	18	7	73	Tails	Win	Tails	$ 73	Me
100 t	win	me	19	8	100	Tails	Win	Tails	$ 100	Me
100 h	win	me	20	9	100	Heads	Win	Heads	$ 100	Me
100 t	win	me	21	10	100	Tails	Win	Tails	$ 100	Me
100 t	lose	me	22	-	100	Tails	Lose	Heads	$ -100	Me

As you can see, on the left I put in 100 t lose me for example
meaning, i bet 100$ on tails but i lost, and i was the one doing it. (sometimes there are other people also coinflipping)
Now i need this simplified information to be put in the charts, and then with formulas i can probably figure out the rest.
And also if its not to hard to do, is it possible to have it at 1 cell where i type my simplified info, then it gets put into the charts and cleans the cell where i put in my info? so i dont have to go over 4000 lines for example.
i hope i cleared my question from my previous post.
I'm not sure how the rules work if its allowed but i will put the link of my previous post here
https://www.mrexcel.com/forum/excel-questions/1098440-coinflipping-charts.html

Yours sincerely,
Ramballah

Ramballah · May 28, 2019

bump....

Ramballah · May 31, 2019

bump..

Rick Rothstein · May 31, 2019

I am going to give you Change event code (install instructions below) which means that as soon as you enter the third value of your three-part entry, the proper line of code will be added to the bottom of the table. In order for this code to work correctly, you must have the following layout on your worksheet (all of the following are text entries into the indicated cell)...

Cell A1: Roll ==>
Cell A2: Number
Cell B2: Winstreak
Cell C2: Amount BET
Cell D2: What's bet on
Cell E2: Win/Lose
Cell F2: What the coin landed on
Cell G2: Profits
Cell H2: Person

You will make your entries in cells B1 through D1 (where cell B1 would get the amount bet followed by a space followed by either an h or t, where cell C1 would get either the word win or lose and D1 would get the persons name (your name must always be the word me). Okay, with that said, here is the code...

Code:

[table="width: 500"]
[tr]
	[td]Private Sub Worksheet_Change(ByVal Target As Range)
  Dim Rw As Long, MaxWinRow As Long, MaxLoseRow As Long
  If Target.Address(0, 0) = "D1" And Len(Range("D1")) > 0 Then
    Rw = Cells(Rows.Count, "A").End(xlUp).Row + 1
    MaxWinRow = Evaluate(Replace("MAX(IF((E3:E#=""Win"")*(H3:H#=""Me""),ROW(E3:E#)))", "#", Rw - 1))
    MaxLoseRow = Evaluate(Replace("MAX(IF((E3:E#=""Lose"")*(H3:H#=""Me""),ROW(E3:E#)))", "#", Rw - 1))
    Cells(Rw, "A").Value = Val(Cells(Rw - 1, "A")) + 1
    Cells(Rw, "C").Resize(, 2).Value = Split([SUBSTITUTE(SUBSTITUTE(LOWER(B1),"t","Tails"),"h","Heads")])
    Cells(Rw, "E").Value = [PROPER(C1)]
    Cells(Rw, "F").Value = [IF(C1="win",IF(RIGHT(B1)="h","Heads","Tails"),IF(RIGHT(B1)="h","Tails","Heads"))]
    Cells(Rw, "G").Value = IIf([D1="me"], IIf(Cells(Rw, "E").Value = "Lose", -1, 1) * Cells(Rw, "c").Value, "")
    If Cells(Rw, "G").Value = Int(Cells(Rw, "G").Value) Then
      Cells(Rw, "G").NumberFormat = "$ 0"
    Else
      Cells(Rw, "G").NumberFormat = "$ 0.00;$ -0.00"
    End If
    Cells(Rw, "H").Value = [PROPER(D1)]
    If [AND(C1 = "win",D1 = "me")] Then
      If MaxWinRow Then
        Cells(Rw, "B").Value = 1 - Cells(MaxWinRow, "B") * (MaxWinRow > MaxLoseRow)
      Else
        Cells(Rw, "B").Value = 1
      End If
    End If
    [B1:D1] = ""
    Range("B1").Select
  End If
End Sub[/td]
[/tr]
[/table]

HOW TO INSTALL Event Code
------------------------------------
If you are new to event code procedures, they are easy to install. To install it, right-click the name tab at the bottom of the worksheet that is to have the functionality to be provided by the event code and select "View Code" from the popup menu that appears. This will open up the code window for that worksheet. Copy/Paste the event code into that code window. That's it... the code will now operate automatically when its particular event procedure is raised by an action you take on the worksheet itself. Note... if you are using XL2007 or above, make sure you save your file as an "Excel Macro-Enabled Workbook (*.xlsm) and answer the "do you want to enable macros" question as "yes" or "OK" (depending on the button label for your version of Excel) the next time you open your workbook.

Ramballah · May 31, 2019

This is perfect!!!!!! Thanks so much its working so perfect!!!

Ramballah · May 31, 2019

Rick Rothstein said:
I am going to give you Change event code (install instructions below) which means that as soon as you enter the third value of your three-part entry, the proper line of code will be added to the bottom of the table. In order for this code to work correctly, you must have the following layout on your worksheet (all of the following are text entries into the indicated cell)...

Cell A1: Roll ==>
Cell A2: Number
Cell B2: Winstreak
Cell C2: Amount BET
Cell D2: What's bet on
Cell E2: Win/Lose
Cell F2: What the coin landed on
Cell G2: Profits
Cell H2: Person

You will make your entries in cells B1 through D1 (where cell B1 would get the amount bet followed by a space followed by either an h or t, where cell C1 would get either the word win or lose and D1 would get the persons name (your name must always be the word me). Okay, with that said, here is the code...

Code:

[TABLE="width: 500"] <tbody>[TR] [TD]Private Sub Worksheet_Change(ByVal Target As Range) Dim Rw As Long, MaxWinRow As Long, MaxLoseRow As Long If Target.Address(0, 0) = "D1" And Len(Range("D1")) > 0 Then Rw = Cells(Rows.Count, "A").End(xlUp).Row + 1 MaxWinRow = Evaluate(Replace("MAX(IF((E3:E#=""Win"")*(H3:H#=""Me""),ROW(E3:E#)))", "#", Rw - 1)) MaxLoseRow = Evaluate(Replace("MAX(IF((E3:E#=""Lose"")*(H3:H#=""Me""),ROW(E3:E#)))", "#", Rw - 1)) Cells(Rw, "A").Value = Val(Cells(Rw - 1, "A")) + 1 Cells(Rw, "C").Resize(, 2).Value = Split([SUBSTITUTE(SUBSTITUTE(LOWER(B1),"t","Tails"),"h","Heads")]) Cells(Rw, "E").Value = [PROPER(C1)] Cells(Rw, "F").Value = [IF(C1="win",IF(RIGHT(B1)="h","Heads","Tails"),IF(RIGHT(B1)="h","Tails","Heads"))] Cells(Rw, "G").Value = IIf([D1="me"], IIf(Cells(Rw, "E").Value = "Lose", -1, 1) * Cells(Rw, "c").Value, "") If Cells(Rw, "G").Value = Int(Cells(Rw, "G").Value) Then Cells(Rw, "G").NumberFormat = "$ 0" Else Cells(Rw, "G").NumberFormat = "$ 0.00;$ -0.00" End If Cells(Rw, "H").Value = [PROPER(D1)] If [AND(C1 = "win",D1 = "me")] Then If MaxWinRow Then Cells(Rw, "B").Value = 1 - Cells(MaxWinRow, "B") * (MaxWinRow > MaxLoseRow) Else Cells(Rw, "B").Value = 1 End If End If [B1:D1] = "" Range("B1").Select End If End Sub[/TD] [/TR] </tbody>[/TABLE]

HOW TO INSTALL Event Code
------------------------------------
If you are new to event code procedures, they are easy to install. To install it, right-click the name tab at the bottom of the worksheet that is to have the functionality to be provided by the event code and select "View Code" from the popup menu that appears. This will open up the code window for that worksheet. Copy/Paste the event code into that code window. That's it... the code will now operate automatically when its particular event procedure is raised by an action you take on the worksheet itself. Note... if you are using XL2007 or above, make sure you save your file as an "Excel Macro-Enabled Workbook (*.xlsm) and answer the "do you want to enable macros" question as "yes" or "OK" (depending on the button label for your version of Excel) the next time you open your workbook.

Now i noticed that if i were to change the layout of the cells, the macro changes the layout again? Can i change how the layout looks in the macro? i mean like the profits in column G is coming up as UK pounds, and column C D E and H arent in bold but the others are. Also i noticed that column C where the amount BET is. The numbers are stored as TEXT and is giving errors... is there a way to solve this?

Rick Rothstein · May 31, 2019

Ramballah said:
Can i change how the layout looks in the macro?

A macro or, as in this case, event code, can do pretty much anything... as long as the programmer knows what is wanted.

Ramballah said:
...and column C D E and H arent in bold but the others are.

My code does nothing to bold or not bold any cell values. If you have specific column values that you want bolded, tell me what they are and I'll build it into my code.

I will revise my code again when you tell me about the bolded columns as discussed above, but here is revised code which I think addresses your other questions and makes an addition to the code which I accidentally omitted originally. So, use this code in place of what I gave you earlier and tell me if every (except for the bold question) works as it should...

Code:

[table="width: 500"]
[tr]
	[td]Private Sub Worksheet_Change(ByVal Target As Range)
  Dim Rw As Long, MaxWinRow As Long, MaxLoseRow As Long
  If Target.Address(0, 0) = "D1" And Len(Range("D1")) > 0 Then
    Application.EnableEvents = False
    Rw = Cells(Rows.Count, "A").End(xlUp).Row + 1
    MaxWinRow = Evaluate(Replace("MAX(IF((E3:E#=""Win"")*(H3:H#=""Me""),ROW(E3:E#)))", "#", Rw - 1))
    MaxLoseRow = Evaluate(Replace("MAX(IF((E3:E#=""Lose"")*(H3:H#=""Me""),ROW(E3:E#)))", "#", Rw - 1))
    Cells(Rw, "A").Value = Val(Cells(Rw - 1, "A")) + 1
    Cells(Rw, "C").Resize(, 2).Value = Split([SUBSTITUTE(SUBSTITUTE(LOWER(B1),"t","Tails"),"h","Heads")])
    Cells(Rw, "C").Value = Cells(Rw, "C").Value
    Cells(Rw, "E").Value = [PROPER(C1)]
    Cells(Rw, "F").Value = [IF(C1="win",IF(RIGHT(B1)="h","Heads","Tails"),IF(RIGHT(B1)="h","Tails","Heads"))]
    Cells(Rw, "G").Value = IIf([D1="me"], IIf(Cells(Rw, "E").Value = "Lose", -1, 1) * Cells(Rw, "c").Value, "")
    If Cells(Rw, "G").Value = Int(Cells(Rw, "G").Value) Then
      Cells(Rw, "G").NumberFormat = "\$ 0"
    Else
      Cells(Rw, "G").NumberFormat = "\$ 0.00;\$ -0.00"
    End If
    Cells(Rw, "H").Value = [PROPER(D1)]
    If [AND(C1 = "win",D1 = "me")] Then
      If MaxWinRow Then
        Cells(Rw, "B").Value = 1 - Cells(MaxWinRow, "B") * (MaxWinRow > MaxLoseRow)
      Else
        Cells(Rw, "B").Value = 1
      End If
    End If
    [B1:D1] = ""
    Range("B1").Select
    Application.EnableEvents = True
  End If
End Sub[/td]
[/tr]
[/table]

Ramballah · May 31, 2019

Rick Rothstein said:

Code:

[TABLE="width: 500"]
<tbody>[TR]
[TD]Private Sub Worksheet_Change(ByVal Target As Range)
  Dim Rw As Long, MaxWinRow As Long, MaxLoseRow As Long
  If Target.Address(0, 0) = "D1" And Len(Range("D1")) > 0 Then
    Application.EnableEvents = False
    Rw = Cells(Rows.Count, "A").End(xlUp).Row + 1
    MaxWinRow = Evaluate(Replace("MAX(IF((E3:E#=""Win"")*(H3:H#=""Me""),ROW(E3:E#)))", "#", Rw - 1))
    MaxLoseRow = Evaluate(Replace("MAX(IF((E3:E#=""Lose"")*(H3:H#=""Me""),ROW(E3:E#)))", "#", Rw - 1))
    Cells(Rw, "A").Value = Val(Cells(Rw - 1, "A")) + 1
    Cells(Rw, "C").Resize(, 2).Value = Split([SUBSTITUTE(SUBSTITUTE(LOWER(B1),"t","Tails"),"h","Heads")])
    Cells(Rw, "C").Value = Cells(Rw, "C").Value
    Cells(Rw, "E").Value = [PROPER(C1)]
    Cells(Rw, "F").Value = [IF(C1="win",IF(RIGHT(B1)="h","Heads","Tails"),IF(RIGHT(B1)="h","Tails","Heads"))]
    Cells(Rw, "G").Value = IIf([D1="me"], IIf(Cells(Rw, "E").Value = "Lose", -1, 1) * Cells(Rw, "c").Value, "")
    If Cells(Rw, "G").Value = Int(Cells(Rw, "G").Value) Then
      Cells(Rw, "G").NumberFormat = "\$ 0"
    Else
      Cells(Rw, "G").NumberFormat = "\$ 0.00;\$ -0.00"
    End If
    Cells(Rw, "H").Value = [PROPER(D1)]
    If [AND(C1 = "win",D1 = "me")] Then
      If MaxWinRow Then
        Cells(Rw, "B").Value = 1 - Cells(MaxWinRow, "B") * (MaxWinRow > MaxLoseRow)
      Else
        Cells(Rw, "B").Value = 1
      End If
    End If
    [B1:D1] = ""
    Range("B1").Select
    Application.EnableEvents = True
  End If
End Sub[/TD]
[/TR]
</tbody>[/TABLE]

Hi, This has fixed the error i get on column C but now i get for example 500.00
Since there is no form of cents involved in my coinflips to me this kind of seems annoying. The profits is now indeed in $ instead of UK Pounds which is good.
As for the bolding. I want column C D E and H to be in bold, the others are in bold, but these 4 columns aren't. So if thats possible to solve then thank you very much!

Rick Rothstein · May 31, 2019

Ramballah said:
Hi, This has fixed the error i get on column C but now i get for example 500.00
Since there is no form of cents involved in my coinflips to me this kind of seems annoying. The profits is now indeed in $ instead of UK Pounds which is good.
As for the bolding. I want column C D E and H to be in bold, the others are in bold, but these 4 columns aren't. So if thats possible to solve then thank you very much!

Does this handle all of the issues for you...

Code:

[table="width: 500"]
[tr]
	[td]Private Sub Worksheet_Change(ByVal Target As Range)
  Dim Rw As Long, MaxWinRow As Long, MaxLoseRow As Long
  If Target.Address(0, 0) = "D1" And Len(Range("D1")) > 0 Then
    Application.EnableEvents = False
    Rw = Cells(Rows.Count, "A").End(xlUp).Row + 1
    MaxWinRow = Evaluate(Replace("MAX(IF((E3:E#=""Win"")*(H3:H#=""Me""),ROW(E3:E#)))", "#", Rw - 1))
    MaxLoseRow = Evaluate(Replace("MAX(IF((E3:E#=""Lose"")*(H3:H#=""Me""),ROW(E3:E#)))", "#", Rw - 1))
    Cells(Rw, "A").Value = Val(Cells(Rw - 1, "A")) + 1
    Cells(Rw, "C").Resize(, 2).Value = Split([SUBSTITUTE(SUBSTITUTE(LOWER(B1),"t","Tails"),"h","Heads")])
    Cells(Rw, "C").Value = Cells(Rw, "C").Value
    Cells(Rw, "C").NumberFormat = "0"
    Cells(Rw, "E").Value = [PROPER(C1)]
    Cells(Rw, "F").Value = [IF(C1="win",IF(RIGHT(B1)="h","Heads","Tails"),IF(RIGHT(B1)="h","Tails","Heads"))]
    Cells(Rw, "G").Value = IIf([D1="me"], IIf(Cells(Rw, "E").Value = "Lose", -1, 1) * Cells(Rw, "c").Value, "")
    Cells(Rw, "G").NumberFormat = "\$ 0"
    Cells(Rw, "H").Value = [PROPER(D1)]
    If [AND(C1 = "win",D1 = "me")] Then
      If MaxWinRow Then
        Cells(Rw, "B").Value = 1 - Cells(MaxWinRow, "B") * (MaxWinRow > MaxLoseRow)
      Else
        Cells(Rw, "B").Value = 1
      End If
    End If
    Cells(Rw, "A").Resize(, 8).Font.Bold = True
    [B1:D1] = ""
    Range("B1").Select
    Application.EnableEvents = True
  End If[/td]
[/tr]
[/table]
End Sub

Ramballah · May 31, 2019

Rick Rothstein said:

Does this handle all of the issues for you...

Code:

[TABLE="width: 500"]
<tbody>[TR]
[TD]Private Sub Worksheet_Change(ByVal Target As Range)
  Dim Rw As Long, MaxWinRow As Long, MaxLoseRow As Long
  If Target.Address(0, 0) = "D1" And Len(Range("D1")) > 0 Then
    Application.EnableEvents = False
    Rw = Cells(Rows.Count, "A").End(xlUp).Row + 1
    MaxWinRow = Evaluate(Replace("MAX(IF((E3:E#=""Win"")*(H3:H#=""Me""),ROW(E3:E#)))", "#", Rw - 1))
    MaxLoseRow = Evaluate(Replace("MAX(IF((E3:E#=""Lose"")*(H3:H#=""Me""),ROW(E3:E#)))", "#", Rw - 1))
    Cells(Rw, "A").Value = Val(Cells(Rw - 1, "A")) + 1
    Cells(Rw, "C").Resize(, 2).Value = Split([SUBSTITUTE(SUBSTITUTE(LOWER(B1),"t","Tails"),"h","Heads")])
    Cells(Rw, "C").Value = Cells(Rw, "C").Value
    Cells(Rw, "C").NumberFormat = "0"
    Cells(Rw, "E").Value = [PROPER(C1)]
    Cells(Rw, "F").Value = [IF(C1="win",IF(RIGHT(B1)="h","Heads","Tails"),IF(RIGHT(B1)="h","Tails","Heads"))]
    Cells(Rw, "G").Value = IIf([D1="me"], IIf(Cells(Rw, "E").Value = "Lose", -1, 1) * Cells(Rw, "c").Value, "")
    Cells(Rw, "G").NumberFormat = "\$ 0"
    Cells(Rw, "H").Value = [PROPER(D1)]
    If [AND(C1 = "win",D1 = "me")] Then
      If MaxWinRow Then
        Cells(Rw, "B").Value = 1 - Cells(MaxWinRow, "B") * (MaxWinRow > MaxLoseRow)
      Else
        Cells(Rw, "B").Value = 1
      End If
    End If
    Cells(Rw, "A").Resize(, 8).Font.Bold = True
    [B1:D1] = ""
    Range("B1").Select
    Application.EnableEvents = True
  End If[/TD]
[/TR]
</tbody>[/TABLE]
End Sub

I have tried to use this code, but the moment i type in my 100 t for example i get an error: Compile error: Expected End Sub
the last End If is marked in blue so i can retype it and this is marked in yellow:

Private Sub Worksheet_Change(ByVal Target As Range)

*Edit* It is whenever i make anychange to the worksheet, no matter which cell it is but if i change the contents i will get this error

Extract information out of a cell.

Ramballah

Active Member

Excel Facts

Ramballah

Active Member

Ramballah

Active Member

Rick Rothstein

MrExcel MVP

Ramballah

Active Member

Ramballah

Active Member

Rick Rothstein

MrExcel MVP

Ramballah

Active Member

Rick Rothstein

MrExcel MVP

Ramballah

Active Member

Similar threads

Forum statistics

Share this page

Extract information out of a cell.

Active Member

Excel Facts

Active Member

Active Member

MrExcel MVP

Active Member

Active Member

MrExcel MVP

Active Member

MrExcel MVP

Active Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock