API tools faq
paste
actorcat

Blackjack Basic

actorcat
Aug 10th, 2024 (edited)
30
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
VisualBasic 96.63 KB | None | 0 0
raw download clone embed print report
  1. 'for all Excellers out there,, this is actually VBA...
  2.  
  3. 'copy and paste into new module in new Excel workbook, then click inside startgame sub and push run... then Follow directions...
  4.  
  5. 'for full version with simulator and 4 different strategies go to:
  6. 'https://www.etsy.com/shop/ExcelByActorkitten
  7.  
  8. 'would still like to know if it works on Apple computer...
  9.  
  10. '''youtube    https://www.youtube.com/watch?v=-2O8IMHLApE
  11. '''rumble     https://rumble.com/v2figrw-blackjack-pro.html
  12.  
  13.  
  14. Option Explicit
  15. Public answer As String, aces As Long, myImage As Shape, bCard As String, cCard As String, cRow As Long, cCol As Long
  16.  
  17. Sub startgame()
  18.  
  19. ' startGame Macro
  20.  
  21.     Sheets.Add after:=ActiveSheet
  22.     ActiveSheet.Name = "play"
  23.    
  24.     ActiveWindow.Zoom = 110
  25.     Range("B1").Select
  26.     ActiveCell.FormulaR1C1 = "H17--->"
  27.     Range("B2").Select
  28.     ActiveCell.FormulaR1C1 = "peek"
  29.     Range("B3").Select
  30.     ActiveCell.FormulaR1C1 = "ins"
  31.     Range("B4").Select
  32.     Selection.Font.Underline = xlUnderlineStyleSingle
  33.     Range("B4").Select
  34.     ActiveCell.FormulaR1C1 = "House"
  35.     Range("E1").Select
  36.     Selection.Font.Underline = xlUnderlineStyleSingle
  37.     ActiveCell.FormulaR1C1 = "Player 1"
  38.     Range("I1").Select
  39.     Selection.Font.Underline = xlUnderlineStyleSingle
  40.     ActiveCell.FormulaR1C1 = "Player 2"
  41.     Range("M1").Select
  42.     Selection.Font.Underline = xlUnderlineStyleSingle
  43.     ActiveCell.FormulaR1C1 = "Player 3"
  44.     Range("Q1").Select
  45.     Selection.Font.Underline = xlUnderlineStyleSingle
  46.     ActiveCell.FormulaR1C1 = "Player 4"
  47.     Range("U1").Select
  48.     Selection.Font.Underline = xlUnderlineStyleSingle
  49.     ActiveCell.FormulaR1C1 = "Player 5"
  50.     Range("Y1").Select
  51.     Selection.Font.Underline = xlUnderlineStyleSingle
  52.     ActiveCell.FormulaR1C1 = "Player 6"
  53.     Range("AC1").Select
  54.     Selection.Font.Underline = xlUnderlineStyleSingle
  55.     ActiveCell.FormulaR1C1 = "Used Decks"
  56.     Range("AC2").Select
  57.     ActiveCell.FormulaR1C1 = "10 cards"
  58.     Range("AC3").Select
  59.     Selection.Font.Underline = xlUnderlineStyleSingle
  60.     ActiveCell.FormulaR1C1 = "Aces"
  61.     Range("AC4").Select
  62.     Selection.Font.Underline = xlUnderlineStyleSingle
  63.     ActiveCell.FormulaR1C1 = "Low cards"
  64.     Range("AC5").Select
  65.     ActiveCell.FormulaR1C1 = "Running count"
  66.     Range("AC6").Select
  67.     Selection.Font.Underline = xlUnderlineStyleSingle
  68.     ActiveCell.FormulaR1C1 = "How many decks"
  69.     Range("AC7").Select
  70.     Selection.Font.Underline = xlUnderlineStyleSingle
  71.     ActiveCell.FormulaR1C1 = "True Count"
  72.     Range("AC8").Select
  73.     Columns("AC:AC").EntireColumn.AutoFit
  74.     Range("E1:AA1").ColumnWidth = 6.8
  75.     Range("C1").Select
  76.     ActiveCell.FormulaR1C1 = "99"
  77.     Range("C2").Select
  78.     Columns("C:C").EntireColumn.AutoFit
  79.     Range("C1").Select
  80.     ActiveCell.FormulaR1C1 = ""
  81.     Range("F1").Select
  82.     ActiveCell.FormulaR1C1 = "99"
  83.     Range("F2").Select
  84.     Columns("F:F").EntireColumn.AutoFit
  85.     Range("F1").Select
  86.     ActiveCell.FormulaR1C1 = ""
  87.     Range("H1").Select
  88.     ActiveCell.FormulaR1C1 = "99"
  89.     Range("H2").Select
  90.     Columns("H:H").EntireColumn.AutoFit
  91.     Range("J1").Select
  92.     ActiveCell.FormulaR1C1 = "99"
  93.     Range("J2").Select
  94.     Columns("J:J").EntireColumn.AutoFit
  95.     Range("L1").Select
  96.     ActiveCell.FormulaR1C1 = "99"
  97.     Range("L2").Select
  98.     Columns("L:L").EntireColumn.AutoFit
  99.     Range("N1").Select
  100.     ActiveCell.FormulaR1C1 = "99"
  101.     Range("N2").Select
  102.     Columns("N:N").EntireColumn.AutoFit
  103.     Range("P1").Select
  104.     ActiveCell.FormulaR1C1 = "99"
  105.     Range("P2").Select
  106.     Columns("P:P").EntireColumn.AutoFit
  107.     Range("R1").Select
  108.     ActiveCell.FormulaR1C1 = "99"
  109.     Range("R2").Select
  110.     Columns("R:R").EntireColumn.AutoFit
  111.     Range("T1").Select
  112.     ActiveCell.FormulaR1C1 = "99"
  113.     Range("T2").Select
  114.     Columns("T:T").EntireColumn.AutoFit
  115.     Range("V1").Select
  116.     ActiveCell.FormulaR1C1 = "99"
  117.     Range("V2").Select
  118.     Columns("V:V").EntireColumn.AutoFit
  119.     Range("X1").Select
  120.     ActiveCell.FormulaR1C1 = "99"
  121.     Range("X2").Select
  122.     Columns("X:X").EntireColumn.AutoFit
  123.     Range("Z1").Select
  124.     ActiveCell.FormulaR1C1 = "99"
  125.     Range("Z2").Select
  126.     Columns("Z:Z").EntireColumn.AutoFit
  127.     Range("AB1").Select
  128.     ActiveCell.FormulaR1C1 = "99"
  129.     Range("AB2").Select
  130.     Columns("AB:AB").EntireColumn.AutoFit
  131.     Columns("E:E").EntireColumn.AutoFit
  132.     Columns("I:I").EntireColumn.AutoFit
  133.     Columns("M:M").EntireColumn.AutoFit
  134.     Columns("Q:Q").EntireColumn.AutoFit
  135.     Columns("U:U").ColumnWidth = 8
  136.     Columns("U:U").EntireColumn.AutoFit
  137.     Columns("Y:Y").EntireColumn.AutoFit
  138.     Range("AD1").Select
  139.     ActiveCell.FormulaR1C1 = "1234.3"
  140.     Range("AD2").Select
  141.     Columns("AD:AD").EntireColumn.AutoFit
  142.     Range("AD1").Select
  143.     ActiveCell.FormulaR1C1 = ""
  144.     Range("AB1").Select
  145.     ActiveCell.FormulaR1C1 = ""
  146.     Range("Z1").Select
  147.     ActiveCell.FormulaR1C1 = ""
  148.     Range("X1").Select
  149.     ActiveCell.FormulaR1C1 = ""
  150.     Range("V1").Select
  151.     ActiveCell.FormulaR1C1 = ""
  152.     Range("T1").Select
  153.     ActiveCell.FormulaR1C1 = ""
  154.     Range("R1").Select
  155.     ActiveCell.FormulaR1C1 = ""
  156.     Range("P1").Select
  157.     ActiveCell.FormulaR1C1 = ""
  158.     Range("N1").Select
  159.     ActiveCell.FormulaR1C1 = ""
  160.     Range("L1").Select
  161.     ActiveCell.FormulaR1C1 = ""
  162.     Range("J1").Select
  163.     ActiveCell.FormulaR1C1 = ""
  164.     Range("H1").Select
  165.     ActiveCell.FormulaR1C1 = ""
  166.     Range("D7").Select
  167.    
  168.     Range("A5:A20").Select
  169.     Selection.RowHeight = 17.3
  170.     Range("S11").Select
  171.  
  172.     Cells.Select
  173.     With Selection.Interior
  174.         .Pattern = xlSolid
  175.         .PatternColorIndex = xlAutomatic
  176.         .Color = 16644813
  177.         .TintAndShade = 0
  178.         .PatternTintAndShade = 0
  179.     End With
  180.     Range("E2").Select
  181.     ActiveCell.FormulaR1C1 = "1000"
  182.     Range("I2").Select
  183.     ActiveCell.FormulaR1C1 = "1000"
  184.     Range("E3").Select
  185.     ActiveCell.FormulaR1C1 = "10"
  186.     Range("I3").Select
  187.     ActiveCell.FormulaR1C1 = "10"
  188.     Range("D2").Select
  189.     Selection.Font.Underline = xlUnderlineStyleSingle
  190.     ActiveCell.FormulaR1C1 = "Bankroll"
  191.     Range("D3").Select
  192.     Selection.Font.Underline = xlUnderlineStyleSingle
  193.     ActiveCell.FormulaR1C1 = "Bet"
  194.     Range("D4").Select
  195.    
  196.    
  197.     ActiveSheet.Buttons.Add(6.6, 12, 37.2, 33).Select
  198.     Selection.OnAction = "Bet"
  199.     Selection.Characters.Text = "Bet"
  200.     With Selection.Characters(Start:=1, Length:=3).Font
  201.         .Name = "Calibri"
  202.         .FontStyle = "Regular"
  203.         .Size = 11
  204.         .Strikethrough = False
  205.         .Superscript = False
  206.         .Subscript = False
  207.         .OutlineFont = False
  208.         .Shadow = False
  209.         .Underline = xlUnderlineStyleNone
  210.         .ColorIndex = 1
  211.     End With
  212.     Range("D6").Select
  213.    
  214.    
  215.     ActiveSheet.Buttons.Add(9, 60, 32.4, 29.4).Select
  216.     Selection.OnAction = "hit"
  217.     Selection.Characters.Text = "hit"
  218.     With Selection.Characters(Start:=1, Length:=3).Font
  219.         .Name = "Calibri"
  220.         .FontStyle = "Regular"
  221.         .Size = 11
  222.         .Strikethrough = False
  223.         .Superscript = False
  224.         .Subscript = False
  225.         .OutlineFont = False
  226.         .Shadow = False
  227.         .Underline = xlUnderlineStyleNone
  228.         .ColorIndex = 1
  229.     End With
  230.     Range("D8").Select
  231.    
  232.    
  233.     ActiveSheet.Buttons.Add(7.2, 105, 32.4, 29.4).Select
  234.     Selection.OnAction = "split_button"
  235.     Selection.Characters.Text = "Split"
  236.     With Selection.Characters(Start:=1, Length:=5).Font
  237.         .Name = "Calibri"
  238.         .FontStyle = "Regular"
  239.         .Size = 11
  240.         .Strikethrough = False
  241.         .Superscript = False
  242.         .Subscript = False
  243.         .OutlineFont = False
  244.         .Shadow = False
  245.         .Underline = xlUnderlineStyleNone
  246.         .ColorIndex = 1
  247.     End With
  248.    
  249.    
  250.     ActiveSheet.Buttons.Add(1.8, 144.6, 39, 25.8).Select
  251.     Selection.OnAction = "double_down"
  252.     Selection.Characters.Text = "Double"
  253.     With Selection.Characters(Start:=1, Length:=6).Font
  254.         .Name = "Calibri"
  255.         .FontStyle = "Regular"
  256.         .Size = 11
  257.         .Strikethrough = False
  258.         .Superscript = False
  259.         .Subscript = False
  260.         .OutlineFont = False
  261.         .Shadow = False
  262.         .Underline = xlUnderlineStyleNone
  263.         .ColorIndex = 1
  264.     End With
  265.  
  266.     ActiveSheet.Buttons.Add(1.8, 180, 35, 25.8).Select
  267.     Selection.OnAction = "surrender"
  268.     Selection.Characters.Text = "sur"
  269.     With Selection.Characters(Start:=1, Length:=3).Font
  270.         .Name = "Calibri"
  271.         .FontStyle = "Regular"
  272.         .Size = 11
  273.         .Strikethrough = False
  274.         .Superscript = False
  275.         .Subscript = False
  276.         .OutlineFont = False
  277.         .Shadow = False
  278.         .Underline = xlUnderlineStyleNone
  279.         .ColorIndex = 1
  280.     End With
  281.  
  282.     'Range("D13").Select
  283.    
  284.    
  285.     ActiveSheet.Buttons.Add(1, 210.6, 45, 30).Select
  286.     Selection.OnAction = "Stand"
  287.     Selection.Characters.Text = "Stand"
  288.     With Selection.Characters(Start:=1, Length:=5).Font
  289.         .Name = "Calibri"
  290.         .FontStyle = "Regular"
  291.         .Size = 11
  292.         .Strikethrough = False
  293.         .Superscript = False
  294.         .Subscript = False
  295.         .OutlineFont = False
  296.         .Shadow = False
  297.         .Underline = xlUnderlineStyleNone
  298.         .ColorIndex = 1
  299.     End With
  300.    
  301.    
  302.    
  303.     ActiveSheet.Buttons.Add(613.8, 10.8, 38.4, 24.6).Select
  304.     Selection.OnAction = "clean"
  305.     Selection.Characters.Text = "clean"
  306.     With Selection.Characters(Start:=1, Length:=5).Font
  307.         .Name = "Calibri"
  308.         .FontStyle = "Regular"
  309.         .Size = 12
  310.         .Strikethrough = False
  311.         .Superscript = False
  312.         .Subscript = False
  313.         .OutlineFont = False
  314.         .Shadow = False
  315.         .Underline = xlUnderlineStyleNone
  316.         .ColorIndex = 1
  317.     End With
  318.    
  319.     ActiveSheet.Buttons.Add(732.6, 10.8, 45, 24.6).Select
  320.     Selection.OnAction = "shuffle_Arr"
  321.     Selection.Characters.Text = "shuffle"
  322.     With Selection.Characters(Start:=1, Length:=7).Font
  323.         .Name = "Calibri"
  324.         .FontStyle = "Regular"
  325.         .Size = 12
  326.         .Strikethrough = False
  327.         .Superscript = False
  328.         .Subscript = False
  329.         .OutlineFont = False
  330.         .Shadow = False
  331.         .Underline = xlUnderlineStyleNone
  332.         .ColorIndex = 1
  333.     End With
  334.    
  335.    
  336.     Range("C1").Select
  337.     Selection.Borders(xlDiagonalDown).LineStyle = xlNone
  338.     Selection.Borders(xlDiagonalUp).LineStyle = xlNone
  339.     With Selection.Borders(xlEdgeLeft)
  340.         .LineStyle = xlContinuous
  341.         .ColorIndex = 0
  342.         .TintAndShade = 0
  343.         .Weight = xlThin
  344.     End With
  345.     With Selection.Borders(xlEdgeTop)
  346.         .LineStyle = xlContinuous
  347.         .ColorIndex = 0
  348.         .TintAndShade = 0
  349.         .Weight = xlThin
  350.     End With
  351.     With Selection.Borders(xlEdgeBottom)
  352.         .LineStyle = xlContinuous
  353.         .ColorIndex = 0
  354.         .TintAndShade = 0
  355.         .Weight = xlThin
  356.     End With
  357.     With Selection.Borders(xlEdgeRight)
  358.         .LineStyle = xlContinuous
  359.         .ColorIndex = 0
  360.         .TintAndShade = 0
  361.         .Weight = xlThin
  362.     End With
  363.     With Selection.Borders(xlInsideVertical)
  364.         .LineStyle = xlContinuous
  365.         .ColorIndex = 0
  366.         .TintAndShade = 0
  367.         .Weight = xlThin
  368.     End With
  369.     With Selection.Borders(xlInsideHorizontal)
  370.         .LineStyle = xlContinuous
  371.         .ColorIndex = 0
  372.         .TintAndShade = 0
  373.         .Weight = xlThin
  374.     End With
  375.     Selection.Borders(xlDiagonalDown).LineStyle = xlNone
  376.     Selection.Borders(xlDiagonalUp).LineStyle = xlNone
  377.     With Selection.Borders(xlEdgeLeft)
  378.         .LineStyle = xlContinuous
  379.         .ColorIndex = 0
  380.         .TintAndShade = 0
  381.         .Weight = xlThin
  382.     End With
  383.     With Selection.Borders(xlEdgeTop)
  384.         .LineStyle = xlContinuous
  385.         .ColorIndex = 0
  386.         .TintAndShade = 0
  387.         .Weight = xlThin
  388.     End With
  389.     With Selection.Borders(xlEdgeBottom)
  390.         .LineStyle = xlContinuous
  391.         .ColorIndex = 0
  392.         .TintAndShade = 0
  393.         .Weight = xlThin
  394.     End With
  395.     With Selection.Borders(xlEdgeRight)
  396.         .LineStyle = xlContinuous
  397.         .ColorIndex = 0
  398.         .TintAndShade = 0
  399.         .Weight = xlThin
  400.     End With
  401.     With Selection.Borders(xlInsideVertical)
  402.         .LineStyle = xlContinuous
  403.         .ColorIndex = 0
  404.         .TintAndShade = 0
  405.         .Weight = xlThin
  406.     End With
  407.     With Selection.Borders(xlInsideHorizontal)
  408.         .LineStyle = xlContinuous
  409.         .ColorIndex = 0
  410.         .TintAndShade = 0
  411.         .Weight = xlThin
  412.     End With
  413.     Range("C2").Select
  414.     Selection.Borders(xlDiagonalDown).LineStyle = xlNone
  415.     Selection.Borders(xlDiagonalUp).LineStyle = xlNone
  416.     With Selection.Borders(xlEdgeLeft)
  417.         .LineStyle = xlContinuous
  418.         .ColorIndex = 0
  419.         .TintAndShade = 0
  420.         .Weight = xlThin
  421.     End With
  422.     With Selection.Borders(xlEdgeTop)
  423.         .LineStyle = xlContinuous
  424.         .ColorIndex = 0
  425.         .TintAndShade = 0
  426.         .Weight = xlThin
  427.     End With
  428.     With Selection.Borders(xlEdgeBottom)
  429.         .LineStyle = xlContinuous
  430.         .ColorIndex = 0
  431.         .TintAndShade = 0
  432.         .Weight = xlThin
  433.     End With
  434.     With Selection.Borders(xlEdgeRight)
  435.         .LineStyle = xlContinuous
  436.         .ColorIndex = 0
  437.         .TintAndShade = 0
  438.         .Weight = xlThin
  439.     End With
  440.     With Selection.Borders(xlInsideVertical)
  441.         .LineStyle = xlContinuous
  442.         .ColorIndex = 0
  443.         .TintAndShade = 0
  444.         .Weight = xlThin
  445.     End With
  446.     With Selection.Borders(xlInsideHorizontal)
  447.         .LineStyle = xlContinuous
  448.         .ColorIndex = 0
  449.         .TintAndShade = 0
  450.         .Weight = xlThin
  451.     End With
  452.     Range("C3").Select
  453.     Selection.Borders(xlDiagonalDown).LineStyle = xlNone
  454.     Selection.Borders(xlDiagonalUp).LineStyle = xlNone
  455.     With Selection.Borders(xlEdgeLeft)
  456.         .LineStyle = xlContinuous
  457.         .ColorIndex = 0
  458.         .TintAndShade = 0
  459.         .Weight = xlThin
  460.     End With
  461.     With Selection.Borders(xlEdgeTop)
  462.         .LineStyle = xlContinuous
  463.         .ColorIndex = 0
  464.         .TintAndShade = 0
  465.         .Weight = xlThin
  466.     End With
  467.     With Selection.Borders(xlEdgeBottom)
  468.         .LineStyle = xlContinuous
  469.         .ColorIndex = 0
  470.         .TintAndShade = 0
  471.         .Weight = xlThin
  472.     End With
  473.     With Selection.Borders(xlEdgeRight)
  474.         .LineStyle = xlContinuous
  475.         .ColorIndex = 0
  476.         .TintAndShade = 0
  477.         .Weight = xlThin
  478.     End With
  479.     With Selection.Borders(xlInsideVertical)
  480.         .LineStyle = xlContinuous
  481.         .ColorIndex = 0
  482.         .TintAndShade = 0
  483.         .Weight = xlThin
  484.     End With
  485.     With Selection.Borders(xlInsideHorizontal)
  486.         .LineStyle = xlContinuous
  487.         .ColorIndex = 0
  488.         .TintAndShade = 0
  489.         .Weight = xlThin
  490.     End With
  491.         Range("AC1:AD7").Select
  492.     Selection.Borders(xlDiagonalDown).LineStyle = xlNone
  493.     Selection.Borders(xlDiagonalUp).LineStyle = xlNone
  494.     With Selection.Borders(xlEdgeLeft)
  495.         .LineStyle = xlContinuous
  496.         .ColorIndex = 0
  497.         .TintAndShade = 0
  498.         .Weight = xlThin
  499.     End With
  500.     With Selection.Borders(xlEdgeTop)
  501.         .LineStyle = xlContinuous
  502.         .ColorIndex = 0
  503.         .TintAndShade = 0
  504.         .Weight = xlThin
  505.     End With
  506.     With Selection.Borders(xlEdgeBottom)
  507.         .LineStyle = xlContinuous
  508.         .ColorIndex = 0
  509.         .TintAndShade = 0
  510.         .Weight = xlThin
  511.     End With
  512.     With Selection.Borders(xlEdgeRight)
  513.         .LineStyle = xlContinuous
  514.         .ColorIndex = 0
  515.         .TintAndShade = 0
  516.         .Weight = xlThin
  517.     End With
  518.     With Selection.Borders(xlInsideVertical)
  519.         .LineStyle = xlContinuous
  520.         .ColorIndex = 0
  521.         .TintAndShade = 0
  522.         .Weight = xlThin
  523.     End With
  524.     With Selection.Borders(xlInsideHorizontal)
  525.         .LineStyle = xlContinuous
  526.         .ColorIndex = 0
  527.         .TintAndShade = 0
  528.         .Weight = xlThin
  529.     End With
  530.     Selection.Borders(xlDiagonalDown).LineStyle = xlNone
  531.     Selection.Borders(xlDiagonalUp).LineStyle = xlNone
  532.     With Selection.Borders(xlEdgeLeft)
  533.         .LineStyle = xlContinuous
  534.         .ColorIndex = 0
  535.         .TintAndShade = 0
  536.         .Weight = xlThin
  537.     End With
  538.     With Selection.Borders(xlEdgeTop)
  539.         .LineStyle = xlContinuous
  540.         .ColorIndex = 0
  541.         .TintAndShade = 0
  542.         .Weight = xlThin
  543.     End With
  544.     With Selection.Borders(xlEdgeBottom)
  545.         .LineStyle = xlContinuous
  546.         .ColorIndex = 0
  547.         .TintAndShade = 0
  548.         .Weight = xlThin
  549.     End With
  550.     With Selection.Borders(xlEdgeRight)
  551.         .LineStyle = xlContinuous
  552.         .ColorIndex = 0
  553.         .TintAndShade = 0
  554.         .Weight = xlThin
  555.     End With
  556.     With Selection.Borders(xlInsideVertical)
  557.         .LineStyle = xlContinuous
  558.         .ColorIndex = 0
  559.         .TintAndShade = 0
  560.         .Weight = xlThin
  561.     End With
  562.     With Selection.Borders(xlInsideHorizontal)
  563.         .LineStyle = xlContinuous
  564.         .ColorIndex = 0
  565.         .TintAndShade = 0
  566.         .Weight = xlThin
  567.     End With
  568.    
  569.    
  570.     ActiveSheet.Buttons.Add(6.6, 265, 31.8, 20).Select
  571.     Selection.OnAction = "BackUp"
  572.     Selection.Characters.Text = "back"
  573.     With Selection.Characters(Start:=1, Length:=4).Font
  574.         .Name = "Calibri"
  575.         .FontStyle = "Regular"
  576.         .Size = 12
  577.         .Strikethrough = False
  578.         .Superscript = False
  579.         .Subscript = False
  580.         .OutlineFont = False
  581.         .Shadow = False
  582.         .Underline = xlUnderlineStyleNone
  583.         .ColorIndex = 1
  584.     End With
  585.     Range("D19").Select
  586.    
  587.    
  588.     ActiveSheet.Buttons.Add(1, 291, 45, 20).Select
  589.     Selection.OnAction = "Forward"
  590.     Selection.Characters.Text = "forward"
  591.     With Selection.Characters(Start:=1, Length:=7).Font
  592.         .Name = "Calibri"
  593.         .FontStyle = "Regular"
  594.         .Size = 12
  595.         .Strikethrough = False
  596.         .Superscript = False
  597.         .Subscript = False
  598.         .OutlineFont = False
  599.         .Shadow = False
  600.         .Underline = xlUnderlineStyleNone
  601.         .ColorIndex = 1
  602.     End With
  603.     'ActiveSheet.Shapes("Button 13").ScaleWidth 1.1804199475, msoFalse, _
  604.         msoScaleFromTopLeft
  605.    'Range("B20").Select
  606.    'ActiveSheet.Shapes.Range(Array("Button 12")).Select
  607.    Range("E15").Select
  608.     With ActiveWindow
  609.         .SplitColumn = 1
  610.         .SplitRow = 0
  611.     End With
  612.    
  613.     Range("D1").Select
  614.     ActiveCell.FormulaR1C1 = "=RC[26]"
  615.     With Selection.Interior
  616.         .Pattern = xlSolid
  617.         .PatternColorIndex = xlAutomatic
  618.         .Color = 65535
  619.         .TintAndShade = 0
  620.         .PatternTintAndShade = 0
  621.     End With
  622.  
  623.     Selection.NumberFormat = "0.00"
  624.    
  625.     Range("B1").Select
  626.     ActiveSheet.Buttons.Add(54, 2.4, 49.8, 12.6).Select
  627.     Selection.OnAction = "H17YN"
  628.     Selection.Characters.Text = "H17"
  629.     Range("B2").Select
  630.     ActiveSheet.Buttons.Add(54, 18, 49.8, 12.6).Select
  631.     Selection.OnAction = "peekYN"
  632.     Selection.Characters.Text = "PEEK"
  633.     Range("B3").Select
  634.     ActiveSheet.Buttons.Add(54, 34, 49.8, 12.6).Select
  635.     Selection.OnAction = "insYN"
  636.     Selection.Characters.Text = "INS"
  637.    
  638.    
  639.     ActiveWindow.FreezePanes = True
  640.  
  641.     Application.CutCopyMode = False
  642.     Sheets("play").Range("ad6").Value = 6
  643.    
  644.     Sheets("play").Range("ad1").Formula = "=((AD6*52)-COUNTA(AG:AG))/52"
  645.     Sheets("play").Range("ad5").Formula = "=AD4-AD3-AD2"
  646.     Sheets("play").Range("ad7").Formula = "=$AD$5/($AD$6-$AD$1)"
  647.     Range("a1").Select
  648. shuffle_Arr
  649. instructions
  650.  
  651. End Sub
  652.  
  653. Sub instructions()
  654. '
  655. ' instructions Macro
  656. '
  657.  
  658. '
  659.    Sheets.Add after:=ActiveSheet
  660.     ActiveSheet.Select
  661.     ActiveSheet.Name = "instructions"
  662.     Sheets("instructions").Select
  663.     Range("C1").Select
  664.  
  665.     Range("c1").Select
  666.     Sheets("instructions").Select
  667.     ActiveCell.FormulaR1C1 = "First you need to download some cards:"
  668.     Range("g1").Select
  669.     ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
  670.         "https://www.dropbox.com/scl/fo/2kfvqjum0tykkqxat6mfa/h?dl=0&rlkey=xdwe9qmx3igsaz1d2s5vs2zx1" _
  671.         , TextToDisplay:="cards"
  672.     Sheets("instructions").Select
  673.     Application.CutCopyMode = False
  674.     Range("c2").Select
  675.     ActiveCell.FormulaR1C1 = "Open the cards folder"
  676.     Range("c3").Select
  677.     ActiveCell.FormulaR1C1 = "right click on url and copy address"
  678.     Range("c4").Select
  679.     ActiveCell.FormulaR1C1 = _
  680.         "paste card address in A20 on play sheet"
  681.  
  682.     Range("C6").Select
  683.     Sheets("instructions").Select
  684.     ActiveCell.FormulaR1C1 = _
  685.         "if you want the dealer to hit on a soft 17, then put a capital Y in "
  686.     Sheets("instructions").Select
  687.     ActiveCell.FormulaR1C1 = _
  688.         "if you want the dealer to hit on a soft 17, then put a capital Y in C1"
  689.  
  690.     Range("C7").Select
  691.     Sheets("instructions").Select
  692.     ActiveCell.FormulaR1C1 = _
  693.         "if you want the dealer to ""Peek"" for a blackjack then put a capital Y in C2"
  694.     Range("C8").Select
  695.     Sheets("instructions").Select
  696.     ActiveCell.FormulaR1C1 = "if you want insurance then put a capital Y in C3"
  697.     Range("C9").Select
  698.     Sheets("instructions").Select
  699.     Range("C10").Select
  700.     ActiveCell.FormulaR1C1 = "running count calculation is:"
  701.     Range("C11").Select
  702.     ActiveCell.FormulaR1C1 = "cards 2-6 you add 1"
  703.     Range("C12").Select
  704.     ActiveCell.FormulaR1C1 = "cards 10 - A, you subtract one"
  705.     Range("C13").Select
  706.     ActiveCell.FormulaR1C1 = _
  707.         "so if you have a 10 and a deuce those cancel out each other"
  708.     Range("C14").Select
  709.     ActiveCell.FormulaR1C1 = "but if you have 2 aces that counts as -2"
  710.     Range("C15").Select
  711.     ActiveCell.FormulaR1C1 = "if 2,3,4,5,6 come then that would be +5"
  712.     Range("C16").Select
  713.     ActiveCell.FormulaR1C1 = _
  714.         "and so on and so on,,, easy, the hard part is memorizing the chart:"
  715.     Range("C17").Select
  716.     ActiveCell.FormulaR1C1 = "here is the chart:"
  717.     Range("C18").Select
  718.     Sheets("instructions").Select
  719.     Range("e17").Select
  720.  
  721.     ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
  722.         "https://www.blackjackapprenticeship.com/wp-content/uploads/2019/07/BJA_S17.pdf" _
  723.         , TextToDisplay:="chart"
  724.    
  725.         Range("C19").Select
  726.     ActiveCell.FormulaR1C1 = _
  727.         "if you do everything according to the chart, you should make money..."
  728.     Sheets("instructions").Select
  729.     Range("C20").Select
  730.     ActiveCell.FormulaR1C1 = _
  731.         "the true count is the running count divided by the number of decks left"
  732.     Range("C21").Select
  733.     ActiveCell.FormulaR1C1 = _
  734.         "you usually want a true count of 3 or more to start raising bets"
  735.  
  736.  
  737.     Range("M1").Select
  738.     Sheets("instructions").Select
  739.     ActiveCell.FormulaR1C1 = _
  740.         "heres a great video of a guy that toured the country playing blackjack,,,"
  741.     Range("M2").Select
  742.     ActiveCell.FormulaR1C1 = _
  743.         "you might want to watch it before you decide to do it yourself,,, lol…"
  744.     Range("M3").Select
  745.     ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
  746.         "https://rumble.com/v1frh4h-card-counter-hits-casinos-on-american-road-trip-inside-the-edge-wonder.html" _
  747.         , TextToDisplay:="card counter road trip"
  748.     Range("M5").Select
  749.     Sheets("instructions").Select
  750.     ActiveCell.FormulaR1C1 = "hella, good site for card counting:"
  751.     Range("M6").Select
  752.     ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
  753.         "https://www.youtube.com/channel/UCdnKUMfRVRHuGrciZAqaCwQ", TextToDisplay:= _
  754.         "blackjack apprenticeship"
  755.        
  756.     Range("M11").Select
  757.     ActiveCell.FormulaR1C1 = "here's my Etsy..."
  758.     Range("M12").Select
  759.     ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
  760.         "https://www.etsy.com/shop/ExcelByActorkitten?ref=shop_sugg_market", _
  761.         TextToDisplay:="ExcelByActorkitten"
  762.    
  763.  
  764.     Range("M17").Select
  765.     Range("C1:I21").Select
  766.     With Selection.Interior
  767.         .Pattern = xlSolid
  768.         .PatternColorIndex = xlAutomatic
  769.         .Color = 65535
  770.         .TintAndShade = 0
  771.         .PatternTintAndShade = 0
  772.     End With
  773.     Range("M1:S2").Select
  774.     With Selection.Interior
  775.         .Pattern = xlSolid
  776.         .PatternColorIndex = xlAutomatic
  777.         .Color = 65535
  778.         .TintAndShade = 0
  779.         .PatternTintAndShade = 0
  780.     End With
  781.     Range("M5:p5").Select
  782.     With Selection.Interior
  783.         .Pattern = xlSolid
  784.         .PatternColorIndex = xlAutomatic
  785.         .Color = 65535
  786.         .TintAndShade = 0
  787.         .PatternTintAndShade = 0
  788.     End With
  789.     Range("M11:p11").Select
  790.     With Selection.Interior
  791.         .Pattern = xlSolid
  792.         .PatternColorIndex = xlAutomatic
  793.         .Color = 65535
  794.         .TintAndShade = 0
  795.         .PatternTintAndShade = 0
  796.     End With
  797.  
  798. Range("a:a").Delete
  799. Range("a1").Select
  800. End Sub
  801. Sub autoYN()
  802. If Sheets("play").Range("H1").Value = "Y" Then Sheets("play").Range("H1").Value = "N": Exit Sub
  803. If Sheets("play").Range("H1").Value <> "Y" Then Sheets("play").Range("H1").Value = "Y"
  804. End Sub
  805.  
  806. Sub H17YN()
  807. If Sheets("play").Range("C1").Value = "Y" Then Sheets("play").Range("C1").Value = "N": Exit Sub
  808. If Sheets("play").Range("C1").Value <> "Y" Then Sheets("play").Range("C1").Value = "Y"
  809. End Sub
  810.  
  811. Sub peekYN()
  812. If Sheets("play").Range("C2").Value = "Y" Then Sheets("play").Range("C2").Value = "N": Exit Sub
  813. If Sheets("play").Range("C2").Value <> "Y" Then Sheets("play").Range("C2").Value = "Y"
  814. End Sub
  815.  
  816. Sub insYN()
  817. If Sheets("play").Range("C3").Value = "Y" Then Sheets("play").Range("C3").Value = "N": Exit Sub
  818. If Sheets("play").Range("C3").Value <> "Y" Then Sheets("play").Range("C3").Value = "Y"
  819. End Sub
  820.  
  821. Sub Auto()
  822. 'auto1
  823.  
  824. End Sub
  825.  
  826.  
  827.  
  828. Sub colLoop(ColLet As String, RowNum As Long, standCount As Long, cardcount As Long, card As String)
  829. 'colloop1
  830.  
  831. aces = 0
  832. Application.ScreenUpdating = False
  833. Application.EnableEvents = False
  834.             cardcount = 0
  835.             card = 0
  836.             RowNum = 5
  837.             'If colLet = "B" Then Stop
  838. Do
  839.     card = Sheets("play").Range(ColLet & RowNum).Value
  840.     If Sheets("play").Range(ColLet & RowNum).Value = "A" Then aceCount aces
  841.     If Sheets("play").Range(ColLet & RowNum).Value = "A" Then card = 11
  842.     If Sheets("play").Range(ColLet & RowNum).Value = "K" Then card = 10
  843.     If Sheets("play").Range(ColLet & RowNum).Value = "Q" Then card = 10
  844.     If Sheets("play").Range(ColLet & RowNum).Value = "J" Then card = 10
  845.    
  846.     cardcount = cardcount + card
  847.     If cardcount > 21 And aces > 0 Then cardcount = cardcount - 10: aces = aces - 1
  848.     If cardcount > 21 And aces > 0 Then cardcount = cardcount - 10: aces = aces - 1
  849.     If standCount = 17 And aces > 0 And Sheets("play").Range("c1").Value = "Y" Then standCount = 18
  850.     If cardcount >= 17 And aces = 0 And Sheets("play").Range("c1").Value = "Y" Then Exit Do
  851.     If cardcount >= standCount Then Exit Do
  852.     If cardcount < standCount And RowNum >= 6 Then hit
  853.    
  854.     RowNum = RowNum + 1
  855.    
  856.     DoEvents
  857. Loop
  858.    
  859.    
  860. Application.ScreenUpdating = True
  861. Application.EnableEvents = True
  862.  
  863. End Sub
  864.  
  865.  
  866.  
  867. Sub automatic()
  868.  
  869.  
  870. End Sub
  871.  
  872. Sub aceCount(aces As Long)
  873. 'acecount1
  874.  
  875. aces = aces + 1
  876. End Sub
  877.  
  878. Sub player1()
  879.  
  880. Sheets("play").Range("E1").Interior.Color = vbGreen
  881. If Sheets("play").Range("h1").Value = "Y" Then Call Auto
  882. 'And Sheets("play").Cells(Rows.Count, "ag").End(xlUp).Row > 51
  883. End Sub
  884. Sub player2()
  885.  
  886. Sheets("play").Range("I1").Interior.Color = vbGreen
  887.  
  888. End Sub
  889. Sub player3()
  890.  
  891. Sheets("play").Range("M1").Interior.Color = vbGreen
  892.  
  893. End Sub
  894. Sub player4()
  895.  
  896. Sheets("play").Range("Q1").Interior.Color = vbGreen
  897.  
  898. End Sub
  899. Sub player5()
  900.  
  901. Sheets("play").Range("U1").Interior.Color = vbGreen
  902.  
  903. End Sub
  904. Sub player6()
  905.  
  906. Sheets("play").Range("Y1").Interior.Color = vbGreen
  907.  
  908. End Sub
  909.  
  910. Sub player1_split()
  911.  
  912. Sheets("play").Range("G1").Interior.Color = vbGreen
  913.  
  914. End Sub
  915. Sub player2_split()
  916.  
  917. Sheets("play").Range("K1").Interior.Color = vbGreen
  918.  
  919. End Sub
  920. Sub player3_split()
  921.  
  922. Sheets("play").Range("O1").Interior.Color = vbGreen
  923.  
  924. End Sub
  925. Sub player4_split()
  926.  
  927. Sheets("play").Range("S1").Interior.Color = vbGreen
  928.  
  929. End Sub
  930. Sub player5_split()
  931.  
  932. Sheets("play").Range("W1").Interior.Color = vbGreen
  933.  
  934. End Sub
  935. Sub player6_split()
  936.  
  937. Sheets("play").Range("AA1").Interior.Color = vbGreen
  938.  
  939. End Sub
  940.  
  941. Sub copy_paste()
  942. 'copypaste1
  943.  
  944. Application.ScreenUpdating = False
  945.  
  946. Sheets("play").Range("al:bo").Insert
  947. Sheets("play").Range("b1:ad20").Copy
  948. Sheets("play").Range("aL1").PasteSpecial Paste:=xlPasteValues
  949. Sheets("play").Range("al1:bo20").Font.ColorIndex = vbBlack
  950. Sheets("play").Range("al1:bo20").NumberFormat = "@"
  951. Sheets("play").Range("al1:bo1").ColumnWidth = 4.6
  952. Sheets("play").Range("al1").Value = Sheets("play").Range("a1").Value
  953. Sheets("play").Range("a1").Value = Sheets("play").Range("a1").Value + 1
  954. Application.ScreenUpdating = True
  955.  
  956. End Sub
  957.  
  958. Sub BackUp()
  959. 'backup1
  960. Dim a As Long, b As Long
  961.  
  962. If Selection.Column < 38 Then
  963.     ActiveWindow.ScrollRow = 1
  964.     ActiveWindow.ScrollColumn = 38
  965.     Cells(1, 38).Select
  966.     Exit Sub
  967. End If
  968.  
  969. If ActiveWindow.ScrollColumn >= 38 Then
  970.     ActiveWindow.ScrollRow = 1
  971.     ActiveWindow.ScrollColumn = ActiveWindow.ScrollColumn + 30
  972.  
  973. End If
  974.  
  975. End Sub
  976.  
  977. Sub Forward()
  978. 'forward1
  979.  
  980. Dim a As Long, b As Long
  981. If ActiveWindow.ScrollColumn >= 38 Then
  982.     ActiveWindow.ScrollRow = 1
  983.     ActiveWindow.ScrollColumn = ActiveWindow.ScrollColumn - 30
  984. End If
  985.  
  986. If ActiveWindow.ScrollColumn < 38 Then ActiveWindow.ScrollColumn = 1
  987. End Sub
  988.  
  989. Sub clean()
  990. 'clean1
  991.  
  992. Dim p As String, q As Long, x As Long, longrow As Long
  993. 'p = column letter
  994. 'q = column number
  995. x = longrow
  996. Application.ScreenUpdating = False
  997.  
  998. For q = 5 To 27 Step 2
  999. p = NumbersToColumns(q)
  1000. Sheets("play").Range(p & 1).Interior.Color = RGB(205, 250, 253)
  1001. Next q
  1002. Sheets("play").Range("b1").Interior.Color = RGB(205, 250, 253)
  1003.  
  1004. For q = 7 To 27 Step 4
  1005. p = NumbersToColumns(q)
  1006. Sheets("play").Range(p & 3).Value = ""
  1007. Next q
  1008.  
  1009. Dim rng As Range, i As Long, j As Long
  1010. Dim Name As String, k As String
  1011. Dim pic As Picture
  1012.  
  1013. 'For i = 2 To 27
  1014. 'longrow = Sheets("play").Cells(99, i).End(xlUp).Row
  1015. '
  1016. '    For j = 5 To longrow
  1017. '
  1018. '    p = NumbersToColumns(i)
  1019. '    k = NumbersToColumns(i + 36)
  1020. '    For Each pic In ActiveSheet.Pictures
  1021. '
  1022. '        Set rng = ActiveSheet.Range(p & j)
  1023. '        If rng.Value = "" Then GoTo label
  1024. '        If rng.Value = "S" Then GoTo label
  1025. '        If rng.Value = "D" Then GoTo label
  1026. '        If rng.Value = "H" Then GoTo label
  1027. '        If rng.Value = "C" Then GoTo label
  1028. '        If pic.Left < 1000 Then
  1029. '        If Int(pic.Top) = Int(rng.Top) And Int(pic.Left) = Int(rng.Left) Then
  1030. '            Name = pic.Name
  1031. '        End If
  1032. '
  1033. '
  1034. '    End If
  1035. '    Next pic
  1036. '    Set pic = ActiveSheet.Pictures(Name)
  1037. '    Set rng = ActiveSheet.Range(k & j)
  1038. '
  1039. '    pic.Top = rng.Top
  1040. '    pic.Left = rng.Left
  1041. '    'MsgBox Name & " " & rng.Top & " " & rng.Left
  1042. '    Next j
  1043. 'label:
  1044. 'Next i
  1045.  
  1046. For Each pic In ActiveSheet.Pictures
  1047. pic.Delete
  1048. DoEvents
  1049. Next pic
  1050.  
  1051. Sheets("play").Range("E4:AB99").ClearContents
  1052. Sheets("play").Range("E4:AB99").Font.Color = vbBlack
  1053. Sheets("play").Range("B5:C99").ClearContents
  1054. Sheets("play").Range("B5:B99").Font.Color = vbBlack
  1055. Sheets("play").Range("C4").ClearContents
  1056.  
  1057. End Sub
  1058.  
  1059. Sub reset()
  1060. 'reset1
  1061.  
  1062.     Sheets("play").Range("e2").Value = 1000
  1063.     Sheets("play").Range("i2").Value = 1000
  1064.     Sheets("play").Range("m2").Value = 1000
  1065.     Sheets("play").Range("q2").Value = 1000
  1066.     Sheets("play").Range("u2").Value = 1000
  1067.     Sheets("play").Range("y2").Value = 1000
  1068.     Sheets("play").Range("e3").Value = 10
  1069.     Sheets("play").Range("i3").Value = 10
  1070.     Sheets("play").Range("m3").Value = 10
  1071.     Sheets("play").Range("q3").Value = 10
  1072.     Sheets("play").Range("u3").Value = 10
  1073.     Sheets("play").Range("y3").Value = 10
  1074.     Sheets("play").Range("ac8").Value = 0
  1075.  
  1076. End Sub
  1077.  
  1078.  
  1079. Sub Bet()
  1080. 'bet1
  1081.  
  1082. Dim aa As Long, bb As String, lg1 As Long
  1083. Dim x As String, y As Long, z As Long, multiple As Double
  1084. multiple = Sheets("play").Range("p1").Value
  1085.  
  1086. 'Sheets("play").Range("E2").Value = 1000
  1087. 'Sheets("play").Range("I2").Value = 1000
  1088. 'Sheets("play").Range("E3").Value = 10
  1089. 'Sheets("play").Range("I3").Value = 10
  1090. 'sheets("play").Range("AD2").Value = ""
  1091. 'sheets("play").Range("AD3").Value = ""
  1092. 'sheets("play").Range("AD4").Value = ""
  1093. '
  1094. 'sheets("play").Range("G3").Value = ""
  1095. 'sheets("play").Range("K3").Value = ""
  1096. 'sheets("play").Range("O3").Value = ""
  1097. 'sheets("play").Range("S3").Value = ""
  1098. 'sheets("play").Range("W3").Value = ""
  1099. 'sheets("play").Range("AA3").Value = ""
  1100. Range("b1").Select
  1101. Application.ScreenUpdating = False
  1102.  
  1103. Range("e1").Select
  1104.  
  1105. Do
  1106.     If ActiveCell.Interior.Color = vbGreen Then Exit Sub
  1107.     ActiveCell.Offset(0, 1).Select
  1108.     DoEvents
  1109. Loop Until Selection.Address = Sheets("play").Range("ab1").Address
  1110.  
  1111. copy_paste 'If Sheets("play").Range("h1").Value <> "Y" Then copy_paste
  1112.  
  1113. If Sheets("play").Cells(Rows.Count, "ag").End(xlUp).Row <= 50 And Sheets("play").Cells(1, "H").Value = "Y" Then shuffle_Arr
  1114. If Sheets("play").Cells(Rows.Count, "ag").End(xlUp).Row <= 50 And Sheets("play").Cells(1, "H").Value <> "Y" Then
  1115.     answer = MsgBox("shuffle", vbQuestion + vbYesNo) '+ vbDefaultButton2
  1116.    If answer = 6 Then shuffle_Arr
  1117.     If answer = 7 Then Exit Sub
  1118. End If
  1119.  
  1120. clean
  1121.  
  1122. If Sheets("play").Cells(Rows.Count, "ag").End(xlUp).Row <= 50 Then Exit Sub
  1123.  
  1124. If Sheets("play").Range("h1").Value = "Y" Then
  1125.     For y = 5 To 25 Step 4
  1126.     x = NumbersToColumns(y)
  1127.     If Sheets("play").Range(x & 3).Value = "" And Sheets("play").Range(x & 2).Value <> "" Then
  1128.         Sheets("play").Range(x & 3).Value = Sheets("play").Range("n1").Value
  1129.             If Sheets("play").Range("ad7").Value > 3 Then
  1130.             'Sheets("play").Range(x & 3).Value = Sheets("play").Range(x & 3).Value * Sheets("play").Range("p1").Value
  1131.            End If
  1132.         End If
  1133.     Next y
  1134. End If
  1135.  
  1136. If Sheets("play").Range("h1").Value <> "Y" Then
  1137.     For y = 5 To 25 Step 4
  1138.     x = NumbersToColumns(y)
  1139.         If Sheets("play").Range(x & 3).Value = "" And Sheets("play").Range(x & 2).Value <> "" Then
  1140.             MsgBox (Sheets("play").Range(x & 1).Value & " must bet"): Exit Sub
  1141.         End If
  1142.     Next y
  1143. End If
  1144.  
  1145. For y = 5 To 25 Step 4
  1146.  
  1147. x = NumbersToColumns(y) ' player columny = 5 ' player column number
  1148. z = 20  ' A column cards
  1149. aa = 6 ' score column number
  1150. bb = "I"
  1151. If Sheets("play").Range(x & 5).Value <> "" Then GoTo LABEL
  1152.  
  1153. If Sheets("play").Range("h1").Value = "Y" Then Sheets("play").Range(x & 3).Value = Sheets("play").Range("n1").Value
  1154.  
  1155. If Sheets("play").Range("h1").Value = "Y" Then
  1156.     If Sheets("play").Range(x & 3).Value <> "" And Sheets("play").Range("ad7").Value > 3 Then
  1157.         Sheets("play").Range(x & 3).Value = Sheets("play").Range("n1").Value * multiple
  1158.     End If
  1159.         If Sheets("play").Range(x & 3).Value <> "" And Sheets("play").Range("ad7").Value > 6 Then
  1160.         Sheets("play").Range(x & 3).Value = Sheets("play").Range("n1").Value * multiple * 3
  1161.     End If
  1162. End If
  1163.  
  1164. Sheets("play").Range(x & 2).Value = Sheets("play").Range(x & 2).Value - Sheets("play").Range(x & 3).Value
  1165.  
  1166. bCard = Sheets("play").Range("AG1").Value
  1167. cRow = 5
  1168. cCol = y
  1169. InsertImage bCard, cRow, cCol
  1170.  
  1171. bCard = Sheets("play").Range("AG2").Value
  1172. cRow = 6
  1173. cCol = y
  1174. InsertImage bCard, cRow, cCol
  1175.  
  1176. Sheets("play").Range("Aj1:ak2").Copy Sheets("play").Range(x & 5)
  1177. Sheets("play").Range("Ag1:ak2").Delete
  1178.  
  1179.  
  1180.  
  1181. bet_count x
  1182.  
  1183. Application.ScreenUpdating = True
  1184. If Sheets("play").Cells(2, "aa").Value <> "" Then Stop
  1185. If Sheets("play").Cells(2, y).End(xlToRight).Column = 29 Then dealer: Exit Sub
  1186.  
  1187.  
  1188. LABEL:
  1189. DoEvents
  1190. Next y
  1191.  
  1192. End Sub
  1193.  
  1194. Sub bet_count(x As String) 'bet runningcount
  1195. 'betcount1
  1196. If Sheets("play").Range(x & 5).Value = "A" Then Sheets("play").Range("AD3").Value = Sheets("play").Range("AD3").Value + 1
  1197. If Sheets("play").Range(x & 5).Value = "K" Then Sheets("play").Range("AD2").Value = Sheets("play").Range("AD2").Value + 1
  1198. If Sheets("play").Range(x & 5).Value = "Q" Then Sheets("play").Range("AD2").Value = Sheets("play").Range("AD2").Value + 1
  1199. If Sheets("play").Range(x & 5).Value = "J" Then Sheets("play").Range("AD2").Value = Sheets("play").Range("AD2").Value + 1
  1200. If Sheets("play").Range(x & 5).Value = "10" Then Sheets("play").Range("AD2").Value = Sheets("play").Range("AD2").Value + 1
  1201. If Sheets("play").Range(x & 5).Value = "2" Then Sheets("play").Range("AD4").Value = Sheets("play").Range("AD4").Value + 1
  1202. If Sheets("play").Range(x & 5).Value = "3" Then Sheets("play").Range("AD4").Value = Sheets("play").Range("AD4").Value + 1
  1203. If Sheets("play").Range(x & 5).Value = "4" Then Sheets("play").Range("AD4").Value = Sheets("play").Range("AD4").Value + 1
  1204. If Sheets("play").Range(x & 5).Value = "5" Then Sheets("play").Range("AD4").Value = Sheets("play").Range("AD4").Value + 1
  1205. If Sheets("play").Range(x & 5).Value = "6" Then Sheets("play").Range("AD4").Value = Sheets("play").Range("AD4").Value + 1
  1206. If Sheets("play").Range(x & 6).Value = "A" Then Sheets("play").Range("AD3").Value = Sheets("play").Range("AD3").Value + 1
  1207. If Sheets("play").Range(x & 6).Value = "K" Then Sheets("play").Range("AD2").Value = Sheets("play").Range("AD2").Value + 1
  1208. If Sheets("play").Range(x & 6).Value = "Q" Then Sheets("play").Range("AD2").Value = Sheets("play").Range("AD2").Value + 1
  1209. If Sheets("play").Range(x & 6).Value = "J" Then Sheets("play").Range("AD2").Value = Sheets("play").Range("AD2").Value + 1
  1210. If Sheets("play").Range(x & 6).Value = "10" Then Sheets("play").Range("AD2").Value = Sheets("play").Range("AD2").Value + 1
  1211. If Sheets("play").Range(x & 6).Value = "2" Then Sheets("play").Range("AD4").Value = Sheets("play").Range("AD4").Value + 1
  1212. If Sheets("play").Range(x & 6).Value = "3" Then Sheets("play").Range("AD4").Value = Sheets("play").Range("AD4").Value + 1
  1213. If Sheets("play").Range(x & 6).Value = "4" Then Sheets("play").Range("AD4").Value = Sheets("play").Range("AD4").Value + 1
  1214. If Sheets("play").Range(x & 6).Value = "5" Then Sheets("play").Range("AD4").Value = Sheets("play").Range("AD4").Value + 1
  1215. If Sheets("play").Range(x & 6).Value = "6" Then Sheets("play").Range("AD4").Value = Sheets("play").Range("AD4").Value + 1
  1216. End Sub
  1217. Sub shuffle_Arr()
  1218. 'shuffle1
  1219.  
  1220. Dim str As String, a As Long, y As Long, x As Long, arr3() As String
  1221. Dim z As Long, pic As Picture, arr() As String
  1222.  
  1223.  
  1224. Application.ScreenUpdating = False
  1225. 'Debug.Print Application.ScreenUpdating
  1226.  
  1227. Sheets("play").Range("ag:ak").ClearContents
  1228. Sheets("play").Range("AAA:xfd").Delete
  1229.  
  1230. 'Sheets("play").Range("ac8").Value = Sheets("play").Range("ac8").Value + 1
  1231.  
  1232. For y = 0 To Sheets("play").Range("ad6").Value - 1
  1233.    
  1234.    
  1235.     str = "10_of_C,2_of_C,3_of_C,4_of_C,5_of_C,6_of_C,7_of_C,8_of_C,9_of_C,A_of_C,J_of_C,K_of_C,Q_of_C,10_of_D,2_of_D,3_of_D,4_of_D,5_of_D,6_of_D,7_of_D,8_of_D,9_of_D,A_of_D,J_of_D,K_of_D,Q_of_D,10_of_H,2_of_H,3_of_H,4_of_H,5_of_H,6_of_H,7_of_H,8_of_H,9_of_H,A_of_H,J_of_H,K_of_H,Q_of_H,10_of_S,2_of_S,3_of_S,4_of_S,5_of_S,6_of_S,7_of_S,8_of_S,9_of_S,A_of_S,J_of_S,K_of_S,Q_of_S"
  1236.    
  1237.     ReDim arr(1 To 52)
  1238.    
  1239.     arr = Split(str, ",")
  1240.    
  1241.     Dim arr2 As String
  1242.     x = (y * 52) + 1
  1243.     For a = UBound(arr) To LBound(arr) Step -1
  1244.    
  1245.         Dim k As Double
  1246.         k = Int(Rnd * a + 1)
  1247.         If a = 0 And k = 1 Then k = 0
  1248.         arr2 = arr(k)
  1249.         ReDim Preserve arr3(x)
  1250.         arr3(x) = arr2
  1251.         If k > 0 Then arr = DeleteElement(arr2, arr)
  1252.        
  1253.     x = x + 1
  1254.     DoEvents
  1255.     Next a
  1256.  
  1257. Erase arr
  1258. DoEvents
  1259. Next y
  1260.  
  1261. For z = y * 52 To 1 Step -1
  1262.  
  1263.         k = Int(Rnd * z + 1)
  1264.         If z = 0 And k = 1 Then k = 0
  1265.         arr2 = arr3(k)
  1266.  
  1267. Sheets("play").Range("AG" & z).Value = arr2
  1268. If k > 0 Then arr3 = DeleteElement(arr2, arr3)
  1269. DoEvents
  1270. Next z
  1271.  
  1272. Erase arr3
  1273.  
  1274. Sheets("play").Range("af1").Formula = "=rand()"
  1275. Sheets("play").Range("ah1").Formula = "=TEXTBEFORE(AG1, """ & "_" & """)"
  1276. Sheets("play").Range("ai1").Formula = "=TEXTAFTER(AG1, """ & "_" & """, -1)"
  1277.  
  1278. a = Sheets("play").Cells(Rows.Count, "AG").End(xlUp).Row
  1279. Sheets("play").Range("AH1:AI" & a).FillDown
  1280. Sheets("play").Range("Af1:Af" & a).FillDown
  1281. Columns("AF:AG").Select
  1282.     ActiveWorkbook.Worksheets("play").Sort.SortFields.Clear
  1283.     ActiveWorkbook.Worksheets("play").Sort.SortFields.Add2 Key:=Range("AF1:AF" & a _
  1284.         ), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
  1285.     With ActiveWorkbook.Worksheets("play").Sort
  1286.         .SetRange Range("AF1:AG" & a)
  1287.         .Header = xlGuess
  1288.         .MatchCase = False
  1289.         .Orientation = xlTopToBottom
  1290.         .SortMethod = xlPinYin
  1291.         .Apply
  1292.     End With
  1293. Sheets("play").Range("ah1:ai" & a).Copy
  1294. Sheets("play").Range("aj1").PasteSpecial (xlPasteValues)
  1295. Sheets("play").Range("AG1:AK" & a).Font.Color = RGB(205, 250, 253)
  1296. Sheets("play").Range("AD2:AD4").ClearContents
  1297.     Columns("AJ:AJ").Select
  1298.     Selection.TextToColumns Destination:=Range("AJ1"), DataType:=xlDelimited, _
  1299.         TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
  1300.         Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
  1301.         :=Array(1, 1), TrailingMinusNumbers:=True
  1302. 'For Each pic In ActiveSheet.Pictures
  1303. '    pic.Delete
  1304. '    DoEvents
  1305. 'Next pic
  1306.  
  1307. Sheets("play").Range("a1").Value = 0
  1308. Application.ScreenUpdating = True
  1309. Sheets("play").Range("b1").Select
  1310. 'reset
  1311. End Sub
  1312.  
  1313. Public Function NumbersToColumns(myCol As Long)
  1314. 'NumbersToColumns1
  1315.  
  1316. Dim iA As Long, fA As Long
  1317.     If myCol >= 1 And myCol <= 16384 Then
  1318.         iA = Int((myCol - 1) / 26)
  1319.         fA = Int(IIf(iA - 1 > 0, (iA - 1) / 26, 0))
  1320.         NumbersToColumns = IIf(fA > 0, Chr(fA + 64), "") & _
  1321.                         IIf(iA - fA * 26 > 0, Chr(iA - fA * 26 + 64), "") & _
  1322.                         Chr(myCol - iA * 26 + 64)
  1323.     Else
  1324.         NumbersToColumns = False
  1325.     End If
  1326. End Function
  1327.  
  1328.  
  1329.  
  1330. Sub AddRowsToArr(arr, Optional ByVal nRows As Long = 1, Optional overwrite As Boolean = True)
  1331.  
  1332. 'directions:  'AddRowsToArr myArray3, 1  ---no parenthesis
  1333.  
  1334. 'define arrays of needed row and column numbers
  1335.    Dim r, C
  1336.     r = Evaluate("row(1:" & CStr(nRows + UBound(arr) - LBound(arr) + 1) & ")")
  1337.     C = Application.Transpose(Evaluate("row(1:" & CStr(UBound(arr, 1) - LBound(arr, 1) + 1) & ")"))
  1338.     '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1339.    'redimension array to new size
  1340.    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1341.    arr = Application.Index(arr, r, C)
  1342.  
  1343.     '*) optional overwriting added row elements with Empty ~~> see Note below!
  1344.    '...
  1345. End Sub
  1346.  
  1347. Function DeleteElement(x As String, ByRef List() As String) ' As String
  1348.    Dim i As Long, el As Long
  1349.     Dim result() As String
  1350.  
  1351.     ReDim result(UBound(List) - 1)
  1352.  
  1353.     For i = 0 To UBound(List)
  1354.         If x = List(i) Then
  1355.             el = i
  1356.             Exit For
  1357.         End If
  1358.     Next i
  1359.  
  1360.     For i = 0 To UBound(result)
  1361.         If i < el Then
  1362.             result(i) = List(i)
  1363.         Else
  1364.             result(i) = List(i + 1)
  1365.         End If
  1366.     Next i
  1367.  
  1368.     DeleteElement = result
  1369. End Function
  1370.  
  1371. Function sumSkip(target As Range, Scell As Long, Snumber As Long)
  1372. 'sumskip1
  1373. 'sumskip(range,starting row, rows to skip) ie.-range b1:b100, 5, 10 will add every 10th cell starting with the 5th row
  1374. Dim Fnumber As Long, answer As Long, a As Long
  1375. Fnumber = target.Rows.Count / Snumber
  1376. For a = 1 To Fnumber
  1377. answer = answer + Cells(Scell, target.Column).Value
  1378. Scell = Scell + Snumber
  1379. Next
  1380. sumSkip = answer
  1381. End Function
  1382.  
  1383. Sub dealer()
  1384. 'dealer1
  1385.  
  1386. Dim result As Long, x As Long, a As Long, longrow As Long, in3 As String
  1387. Dim y As String, AB As Long, b As Boolean, C As Boolean
  1388. Dim cardcount As Long, card As String
  1389.  
  1390.  
  1391. bCard = Sheets("play").Range("AG1").Value
  1392. cRow = 5
  1393. cCol = 2
  1394. InsertImage bCard, cRow, cCol
  1395.  
  1396. Set myImage = ActiveSheet.Shapes(ActiveSheet.Shapes.Count)
  1397.  
  1398. If Sheets("play").Range("h1").Value <> "Y" Then myImage.Visible = msoFalse
  1399.  
  1400. bCard = Sheets("play").Range("AG2").Value
  1401. cRow = 6
  1402. cCol = 2
  1403. InsertImage bCard, cRow, cCol
  1404.  
  1405. Sheets("play").Range("Aj1:ak2").Copy Sheets("play").Range("B5")
  1406. Sheets("play").Range("Af1:ak2").Delete
  1407.  
  1408. If Sheets("play").Range("B6").Value = "A" And Sheets("play").Range("C3").Value = "Y" _
  1409. And Sheets("play").Range("h1").Value <> "Y" Then insurance
  1410.  
  1411. If Sheets("play").Range("B6").Value = "A" And Sheets("play").Range("C3").Value = "Y" _
  1412. And Sheets("play").Range("h1").Value = "Y" And Sheets("play").Range("ad7").Value > 3 Then insurance
  1413.  
  1414. If Sheets("play").Range("B5").Value = 10 Or Sheets("play").Range("B5").Value = "J" Or Sheets("play").Range("B5").Value = "Q" Or Sheets("play").Range("B5").Value = "K" Then b = True
  1415. If Sheets("play").Range("B6").Value = 10 Or Sheets("play").Range("B6").Value = "J" Or Sheets("play").Range("B6").Value = "Q" Or Sheets("play").Range("B6").Value = "K" Then C = True
  1416.  
  1417. For a = 5 To 27
  1418. y = NumbersToColumns(a)
  1419. If Sheets("play").Range(y & 3).Value = "" Then GoTo label2
  1420. If b = False And Sheets("play").Range(y & 7).Value = "Insurance" Then
  1421. Sheets("play").Range(y & 3).Value = Sheets("play").Range(y & 3).Value * 2 / 3
  1422. Sheets("play").Range(y & 7).Value = ""
  1423. End If
  1424. label2:
  1425. Next a
  1426.  
  1427. Application.ScreenUpdating = False
  1428.  
  1429. If Sheets("play").Range("C2").Value = "Y" And b = True And Sheets("play").Range("B6").Value = "A" Then
  1430. ' Peek shown ace
  1431.  
  1432.     For a = 5 To 27 Step 2
  1433.         x = 5
  1434.         cardcount = 0
  1435.        
  1436.         y = NumbersToColumns(a)
  1437.         If Sheets("play").Range(y & x).Value = "" Then GoTo LABEL
  1438.        
  1439.         If b = True And Sheets("play").Range(y & 7).Value = "Insurance" And Sheets("play").Range("C3").Value = "Y" Then
  1440.         Sheets("play").Range(y & 2).Value = Sheets("play").Range(y & 2).Value + Sheets("play").Range(y & 3).Value
  1441.         Sheets("play").Range(y & 3).Value = Sheets("play").Range(y & 3).Value * 2 / 3
  1442.         Sheets("play").Range(y & 7).Value = ""
  1443.         End If
  1444.        
  1445.         Do Until Sheets("play").Range(y & x).Value = ""
  1446.        
  1447.             longrow = Sheets("play").Cells(99, a).End(xlUp).Row
  1448.            
  1449.             card = Sheets("play").Range(y & x).Value
  1450.             If card = "C" Or card = "H" Or card = "D" Or card = "S" Or card = "BLACKJACK" Or card = "" Then GoTo LABEL
  1451.             If Sheets("play").Range(y & x).Value = "J" Then card = 10
  1452.             If Sheets("play").Range(y & x).Value = "Q" Then card = 10
  1453.             If Sheets("play").Range(y & x).Value = "K" Then card = 10
  1454.             If Sheets("play").Range(y & x).Value = "A" Then card = 11
  1455.             cardcount = cardcount + card
  1456.                 If x = 6 And cardcount = 21 Then
  1457.                     Sheets("play").Range(y & x + 5).Value = "BLACKJACK": Sheets("play").Range(NumbersToColumns(a) & 4).Offset(0, 1) = cardcount
  1458.                 End If
  1459.            
  1460.             x = x + 1
  1461.            
  1462.             DoEvents
  1463.        
  1464.         Loop
  1465. Sheets("play").Range(NumbersToColumns(a) & 4).Offset(0, 1) = cardcount
  1466. LABEL:
  1467.  
  1468.     Next a
  1469.     stand2
  1470. End If
  1471.  
  1472. If Sheets("play").Range("C2").Value = "Y" And C = True And Sheets("play").Range("B5").Value = "A" Then
  1473. ' peek hidden ace
  1474.  
  1475.     For a = 5 To 27 Step 2
  1476.         x = 5
  1477.         cardcount = 0
  1478.        
  1479.         y = NumbersToColumns(a)
  1480.         If Sheets("play").Range(y & x).Value = "" Then GoTo label3
  1481.        
  1482.         Do Until Sheets("play").Range(y & x).Value = ""
  1483.        
  1484.             longrow = Sheets("play").Cells(99, a).End(xlUp).Row
  1485.            
  1486.             card = Sheets("play").Range(y & x).Value
  1487.             If card = "C" Or card = "H" Or card = "D" Or card = "S" Or card = "BLACKJACK" Or card = "" Then GoTo label3
  1488.             If Sheets("play").Range(y & x).Value = "J" Then card = 10
  1489.             If Sheets("play").Range(y & x).Value = "Q" Then card = 10
  1490.             If Sheets("play").Range(y & x).Value = "K" Then card = 10
  1491.             If Sheets("play").Range(y & x).Value = "A" Then card = 11
  1492.             cardcount = cardcount + card
  1493.                 If x = 6 And cardcount = 21 Then
  1494.                     Sheets("play").Range(y & x + 5).Value = "BLACKJACK": Sheets("play").Range(NumbersToColumns(a) & 4).Offset(0, 1) = cardcount
  1495.                 End If
  1496.            
  1497.             x = x + 1
  1498.            
  1499.             DoEvents
  1500.        
  1501.         Loop
  1502. Sheets("play").Range(NumbersToColumns(a) & 4).Offset(0, 1) = cardcount
  1503. label3:
  1504.  
  1505.     Next a
  1506. stand2
  1507. End If
  1508.  
  1509. If Sheets("play").Cells(7, a).Value = "Insurance" Then
  1510.     For a = 5 To 27
  1511.     ' Insurace payout
  1512.    
  1513.        
  1514.         Sheets("play").Cells(3, a).Value = Sheets("play").Cells(3, a).Value * 2 / 3
  1515.         Sheets("play").Cells(7, a).Value = ""
  1516.        
  1517.        
  1518.     DoEvents
  1519.     Next a
  1520. End If
  1521.  
  1522. Application.ScreenUpdating = True
  1523.  
  1524. If Sheets("play").Range("C4").Value = "" Then player1
  1525.  
  1526. End Sub
  1527. Sub split_button()
  1528. 'split1
  1529.  
  1530. Dim longrow As Long, int2 As Long, card As String, cardcount As Long, lg1 As Long
  1531. Dim x As String, y As String, z As String, a As Long, b As Long, aa As Long, bb As Long
  1532.  
  1533. Application.ScreenUpdating = False
  1534.  
  1535. 'x = "E" ' player column
  1536. 'y = "F" ' score column
  1537. 'z = "G" ' split column
  1538. 'a = 5 ' player column number
  1539. 'b = 6 ' score column number
  1540.  
  1541. Range("e1").Select
  1542. Do
  1543.     If ActiveCell.Interior.Color = vbGreen Then Exit Do
  1544.     ActiveCell.Offset(0, 1).Select
  1545.     DoEvents
  1546. Loop Until Selection.Address = Sheets("play").Range("ab1").Address
  1547. If Selection.Address = Sheets("play").Range("ab1").Address Then Exit Sub
  1548.  
  1549.  
  1550. If Sheets("play").Range("E1").Interior.Color = vbGreen Then x = "E"   ' player column number
  1551. If Sheets("play").Range("E1").Interior.Color = vbGreen Then y = "F" ' player column
  1552. If Sheets("play").Range("E1").Interior.Color = vbGreen Then z = "G" ' split player column
  1553. If Sheets("play").Range("E1").Interior.Color = vbGreen Then a = 5
  1554. If Sheets("play").Range("E1").Interior.Color = vbGreen Then b = 6
  1555.  
  1556. If Sheets("play").Range("I1").Interior.Color = vbGreen Then x = "I"  ' player column number
  1557. If Sheets("play").Range("I1").Interior.Color = vbGreen Then y = "J" ' player column
  1558. If Sheets("play").Range("I1").Interior.Color = vbGreen Then z = "K" ' split player column
  1559. If Sheets("play").Range("I1").Interior.Color = vbGreen Then a = 9
  1560. If Sheets("play").Range("I1").Interior.Color = vbGreen Then b = 10
  1561.  
  1562. If Sheets("play").Range("M1").Interior.Color = vbGreen Then x = "M"   ' player column number
  1563. If Sheets("play").Range("M1").Interior.Color = vbGreen Then y = "N" ' player column
  1564. If Sheets("play").Range("M1").Interior.Color = vbGreen Then z = "O" ' split player column
  1565. If Sheets("play").Range("M1").Interior.Color = vbGreen Then a = 13
  1566. If Sheets("play").Range("M1").Interior.Color = vbGreen Then b = 15
  1567.  
  1568. If Sheets("play").Range("Q1").Interior.Color = vbGreen Then x = "Q"   ' player column number
  1569. If Sheets("play").Range("Q1").Interior.Color = vbGreen Then y = "R" ' player column
  1570. If Sheets("play").Range("Q1").Interior.Color = vbGreen Then z = "S" ' split player column
  1571. If Sheets("play").Range("Q1").Interior.Color = vbGreen Then a = 17
  1572. If Sheets("play").Range("Q1").Interior.Color = vbGreen Then b = 18
  1573.  
  1574. If Sheets("play").Range("U1").Interior.Color = vbGreen Then x = "U"   ' player column number
  1575. If Sheets("play").Range("U1").Interior.Color = vbGreen Then y = "V" ' player column
  1576. If Sheets("play").Range("U1").Interior.Color = vbGreen Then z = "W" ' split player column
  1577. If Sheets("play").Range("U1").Interior.Color = vbGreen Then a = 21
  1578. If Sheets("play").Range("U1").Interior.Color = vbGreen Then b = 22
  1579.  
  1580. If Sheets("play").Range("Y1").Interior.Color = vbGreen Then x = "Y"   ' player column number
  1581. If Sheets("play").Range("Y1").Interior.Color = vbGreen Then y = "Z" ' player column
  1582. If Sheets("play").Range("Y1").Interior.Color = vbGreen Then z = "AA" ' split player column
  1583. If Sheets("play").Range("Y1").Interior.Color = vbGreen Then a = 25
  1584. If Sheets("play").Range("Y1").Interior.Color = vbGreen Then b = 26
  1585.  
  1586. If Sheets("play").Range(z & 5).Value <> "" Then MsgBox ("You have already split"): Exit Sub
  1587.  
  1588. split_me x, y, z, a
  1589.  
  1590. Application.ScreenUpdating = True
  1591.  
  1592. End Sub
  1593.  
  1594. Sub split_me(x As String, y As String, z As String, a As Long)
  1595. ' splitme1
  1596.  
  1597. 'x = "E" ' player column
  1598. 'y = "F" ' score column
  1599. 'z = "G" ' split column
  1600. 'a = 5 ' player column number
  1601. 'b = 6 ' score column number
  1602. 'aa = 20 ' A column cards
  1603. 'bb = 200 ' A column split cards
  1604.  
  1605. If Sheets("play").Range(x & 5).Value <> Sheets("play").Range(x & 6).Value Then MsgBox ("You can only split pairs"): Exit Sub
  1606.  
  1607. Dim longrow As Long
  1608. longrow = Sheets("play").Cells(99, a).End(xlUp).Row
  1609. If longrow > 6 Then MsgBox ("You can't split with more than 2 cards"): Exit Sub
  1610.  
  1611.  
  1612. Sheets("play").Range(x & 6, y & 6).Copy Sheets("play").Range(z & 5)
  1613.  
  1614. Dim shp As Picture
  1615. Dim rng As Range
  1616. Dim Name As String
  1617.  
  1618. 'Set the range to the cell you want to check
  1619. Set rng = ActiveSheet.Range(x & 6)
  1620.  
  1621. For Each shp In ActiveSheet.Pictures
  1622.     'Check if the shape is within the specified cell
  1623.    If Int(shp.Top) = Int(rng.Top) And Int(shp.Left) = Int(rng.Left) Then
  1624.         Name = shp.Name
  1625.     End If
  1626. Next shp
  1627.  
  1628. Set shp = ActiveSheet.Pictures(Name)
  1629. Set rng = ActiveSheet.Range(z & 5)
  1630.  
  1631. shp.Top = rng.Top
  1632. shp.Left = rng.Left
  1633.  
  1634. Sheets("play").Range(x & 6, y & 6).ClearContents
  1635.  
  1636. bCard = Sheets("play").Range("AG1").Value
  1637. cRow = 6
  1638. cCol = a
  1639. InsertImage bCard, cRow, cCol
  1640.  
  1641. Sheets("play").Range("Aj1:ak1").Copy Sheets("play").Range(x & 6)
  1642. Sheets("play").Range("Ag1:ak1").Delete
  1643.  
  1644. bCard = Sheets("play").Range("AG1").Value
  1645. cRow = 6
  1646. cCol = a + 2
  1647. InsertImage bCard, cRow, cCol
  1648.  
  1649. Sheets("play").Range("Aj1:ak1").Copy Sheets("play").Range(z & 6)
  1650. Sheets("play").Range("Ag1:ak1").Delete
  1651.  
  1652. split_count x, z
  1653.  
  1654. Sheets("play").Range(x & 3).Copy Sheets("play").Range(z & 3)
  1655. Sheets("play").Range(x & 2).Value = Sheets("play").Range(x & 2).Value - Sheets("play").Range(z & 3).Value
  1656.  
  1657. End Sub
  1658.  
  1659. Sub split_count(x As String, z As String) 'split runningcount
  1660. 'splitcount1
  1661.  
  1662. If Sheets("play").Range(x & 6).Value = "A" Then Sheets("play").Range("AD3").Value = Sheets("play").Range("AD3").Value + 1
  1663. If Sheets("play").Range(x & 6).Value = "K" Then Sheets("play").Range("AD2").Value = Sheets("play").Range("AD2").Value + 1
  1664. If Sheets("play").Range(x & 6).Value = "Q" Then Sheets("play").Range("AD2").Value = Sheets("play").Range("AD2").Value + 1
  1665. If Sheets("play").Range(x & 6).Value = "J" Then Sheets("play").Range("AD2").Value = Sheets("play").Range("AD2").Value + 1
  1666. If Sheets("play").Range(x & 6).Value = "10" Then Sheets("play").Range("AD2").Value = Sheets("play").Range("AD2").Value + 1
  1667. If Sheets("play").Range(x & 6).Value = "2" Then Sheets("play").Range("AD4").Value = Sheets("play").Range("AD4").Value + 1
  1668. If Sheets("play").Range(x & 6).Value = "3" Then Sheets("play").Range("AD4").Value = Sheets("play").Range("AD4").Value + 1
  1669. If Sheets("play").Range(x & 6).Value = "4" Then Sheets("play").Range("AD4").Value = Sheets("play").Range("AD4").Value + 1
  1670. If Sheets("play").Range(x & 6).Value = "5" Then Sheets("play").Range("AD4").Value = Sheets("play").Range("AD4").Value + 1
  1671. If Sheets("play").Range(x & 6).Value = "6" Then Sheets("play").Range("AD4").Value = Sheets("play").Range("AD4").Value + 1
  1672. If Sheets("play").Range(z & 6).Value = "A" Then Sheets("play").Range("AD3").Value = Sheets("play").Range("AD3").Value + 1
  1673. If Sheets("play").Range(z & 6).Value = "K" Then Sheets("play").Range("AD2").Value = Sheets("play").Range("AD2").Value + 1
  1674. If Sheets("play").Range(z & 6).Value = "Q" Then Sheets("play").Range("AD2").Value = Sheets("play").Range("AD2").Value + 1
  1675. If Sheets("play").Range(z & 6).Value = "J" Then Sheets("play").Range("AD2").Value = Sheets("play").Range("AD2").Value + 1
  1676. If Sheets("play").Range(z & 6).Value = "10" Then Sheets("play").Range("AD2").Value = Sheets("play").Range("AD2").Value + 1
  1677. If Sheets("play").Range(z & 6).Value = "2" Then Sheets("play").Range("AD4").Value = Sheets("play").Range("AD4").Value + 1
  1678. If Sheets("play").Range(z & 6).Value = "3" Then Sheets("play").Range("AD4").Value = Sheets("play").Range("AD4").Value + 1
  1679. If Sheets("play").Range(z & 6).Value = "4" Then Sheets("play").Range("AD4").Value = Sheets("play").Range("AD4").Value + 1
  1680. If Sheets("play").Range(z & 6).Value = "5" Then Sheets("play").Range("AD4").Value = Sheets("play").Range("AD4").Value + 1
  1681. If Sheets("play").Range(z & 6).Value = "6" Then Sheets("play").Range("AD4").Value = Sheets("play").Range("AD4").Value + 1
  1682. End Sub
  1683.  
  1684. Sub double_down()
  1685. 'double down1
  1686.  
  1687. Dim z As String, bb As String
  1688. Dim a As Long, x As String, y As Long, aa As Long, cc As Long, dd As Long, longrow As Long, int2 As Long, card As String, cardcount As Long
  1689. Application.ScreenUpdating = False
  1690.  
  1691. Range("e1").Select
  1692. Do
  1693.     If ActiveCell.Interior.Color = vbGreen Then Exit Do
  1694.     ActiveCell.Offset(0, 1).Select
  1695.     DoEvents
  1696. Loop Until Selection.Address = Sheets("play").Range("ab1").Address
  1697. If Selection.Address = Sheets("play").Range("ab1").Address Then Exit Sub
  1698.  
  1699.  
  1700. If Sheets("play").Range("E1").Interior.Color = vbGreen Then x = "E"   ' player column number
  1701. If Sheets("play").Range("E1").Interior.Color = vbGreen Then y = 5 ' player column
  1702.  
  1703. If Sheets("play").Range("G1").Interior.Color = vbGreen Then x = "G"   ' player column number
  1704. If Sheets("play").Range("G1").Interior.Color = vbGreen Then y = 7 ' player column
  1705.  
  1706. If Sheets("play").Range("I1").Interior.Color = vbGreen Then x = "I"  ' player column number
  1707. If Sheets("play").Range("I1").Interior.Color = vbGreen Then y = 9 ' player column
  1708.  
  1709. If Sheets("play").Range("K1").Interior.Color = vbGreen Then x = "K"  ' player column number
  1710. If Sheets("play").Range("K1").Interior.Color = vbGreen Then y = 11 ' player column
  1711.  
  1712. If Sheets("play").Range("M1").Interior.Color = vbGreen Then x = "M"   ' player column number
  1713. If Sheets("play").Range("M1").Interior.Color = vbGreen Then y = 13 ' player column
  1714.  
  1715. If Sheets("play").Range("O1").Interior.Color = vbGreen Then x = "O"  ' player column number
  1716. If Sheets("play").Range("O1").Interior.Color = vbGreen Then y = 15 ' player column
  1717.  
  1718. If Sheets("play").Range("Q1").Interior.Color = vbGreen Then x = "Q"   ' player column number
  1719. If Sheets("play").Range("Q1").Interior.Color = vbGreen Then y = 17 ' player column
  1720.  
  1721. If Sheets("play").Range("S1").Interior.Color = vbGreen Then x = "S"  ' player column number
  1722. If Sheets("play").Range("S1").Interior.Color = vbGreen Then y = 19 ' player column
  1723.  
  1724. If Sheets("play").Range("U1").Interior.Color = vbGreen Then x = "U"   ' player column number
  1725. If Sheets("play").Range("U1").Interior.Color = vbGreen Then y = 21 ' player column
  1726.  
  1727. If Sheets("play").Range("W1").Interior.Color = vbGreen Then x = "W"  ' player column number
  1728. If Sheets("play").Range("W1").Interior.Color = vbGreen Then y = 23 ' player column
  1729.  
  1730. If Sheets("play").Range("Y1").Interior.Color = vbGreen Then x = "Y"   ' player column number
  1731. If Sheets("play").Range("Y1").Interior.Color = vbGreen Then y = 25 ' player column
  1732.  
  1733. If Sheets("play").Range("AA1").Interior.Color = vbGreen Then x = "AA"  ' player column number
  1734. If Sheets("play").Range("AA1").Interior.Color = vbGreen Then y = 27 ' player column
  1735.  
  1736. longrow = Sheets("play").Cells(99, y).End(xlUp).Row
  1737. If longrow >= 7 Then MsgBox ("you can't double down"): Exit Sub
  1738.  
  1739. If Sheets("play").Range("E1").Interior.Color = vbGreen Then doubledown_me x, y, longrow, card, cardcount, int2
  1740. If Sheets("play").Range("I1").Interior.Color = vbGreen Then doubledown_me x, y, longrow, card, cardcount, int2
  1741. If Sheets("play").Range("M1").Interior.Color = vbGreen Then doubledown_me x, y, longrow, card, cardcount, int2
  1742. If Sheets("play").Range("Q1").Interior.Color = vbGreen Then doubledown_me x, y, longrow, card, cardcount, int2
  1743. If Sheets("play").Range("U1").Interior.Color = vbGreen Then doubledown_me x, y, longrow, card, cardcount, int2
  1744. If Sheets("play").Range("Y1").Interior.Color = vbGreen Then doubledown_me x, y, longrow, card, cardcount, int2
  1745.  
  1746. If Sheets("play").Range("G1").Interior.Color = vbGreen Then doubledown_me2 x, y, longrow, card, cardcount, int2
  1747. If Sheets("play").Range("K1").Interior.Color = vbGreen Then doubledown_me2 x, y, longrow, card, cardcount, int2
  1748. If Sheets("play").Range("O1").Interior.Color = vbGreen Then doubledown_me2 x, y, longrow, card, cardcount, int2
  1749. If Sheets("play").Range("S1").Interior.Color = vbGreen Then doubledown_me2 x, y, longrow, card, cardcount, int2
  1750. If Sheets("play").Range("W1").Interior.Color = vbGreen Then doubledown_me2 x, y, longrow, card, cardcount, int2
  1751. If Sheets("play").Range("AA1").Interior.Color = vbGreen Then doubledown_me2 x, y, longrow, card, cardcount, int2
  1752.  
  1753. Sheets("play").Range(x & 4).Offset(0, 1) = cardcount
  1754. If cardcount > 21 Then Sheets("play").Range(x & longrow + 5).Value = "BUST"
  1755. Application.ScreenUpdating = True
  1756.  
  1757. aces = 0
  1758.  
  1759. Dim p As String, q As Long
  1760. For q = 5 To 27 Step 2
  1761. p = NumbersToColumns(q)
  1762. Sheets("play").Range(p & 1).Interior.Color = RGB(205, 250, 253)
  1763. Next q
  1764.  
  1765. If Sheets("play").Cells(3, x).End(xlToRight).Column = 7 Then player1_split: Exit Sub
  1766. If Sheets("play").Cells(3, x).End(xlToRight).Column = 11 Then player2_split: Exit Sub
  1767. If Sheets("play").Cells(3, x).End(xlToRight).Column = 15 Then player3_split: Exit Sub
  1768. If Sheets("play").Cells(3, x).End(xlToRight).Column = 19 Then player4_split: Exit Sub
  1769. If Sheets("play").Cells(3, x).End(xlToRight).Column = 23 Then player5_split: Exit Sub
  1770. If Sheets("play").Cells(3, x).End(xlToRight).Column = 27 Then player6_split: Exit Sub
  1771.  
  1772. If Sheets("play").Cells(3, x).End(xlToRight).Column = 9 Then player2: Exit Sub
  1773. If Sheets("play").Cells(3, x).End(xlToRight).Column = 13 Then player3: Exit Sub
  1774. If Sheets("play").Cells(3, x).End(xlToRight).Column = 17 Then player4: Exit Sub
  1775. If Sheets("play").Cells(3, x).End(xlToRight).Column = 21 Then player5: Exit Sub
  1776. If Sheets("play").Cells(3, x).End(xlToRight).Column = 25 Then player6: Exit Sub
  1777.  
  1778. stand2
  1779.  
  1780. End Sub
  1781.  
  1782. Sub doubledown_me(x As String, y As Long, longrow As Long, card As String, cardcount As Long, int2 As Long)
  1783. ' doubledown player
  1784.  
  1785. aces = 0
  1786. longrow = Sheets("play").Cells(99, y).End(xlUp).Row
  1787. Sheets("play").Range(x & 2).Value = Sheets("play").Range(x & 2).Value - Sheets("play").Range(x & 3).Value
  1788. Sheets("play").Range(x & 3).Value = Sheets("play").Range(x & 3).Value + Sheets("play").Range(x & 3).Value
  1789.  
  1790. For int2 = 5 To 6
  1791. If Sheets("play").Range(x & int2).Value = "A" Then aceCount aces
  1792. Next
  1793.  
  1794. 'x = "E" ' player column
  1795. 'y = 5 ' player column number
  1796. 'z = "G" ' Split column
  1797. 'aa = 16 ' A column cards
  1798. 'bb = "I" ' player 2 column
  1799. 'cc = 20
  1800. 'dd = 39
  1801.  
  1802. bCard = Sheets("play").Range("AG1").Value
  1803. cRow = longrow + 1
  1804. cCol = y
  1805. InsertImage bCard, cRow, cCol
  1806.  
  1807. Sheets("play").Range("Aj1:ak1").Copy Sheets("play").Range(x & longrow + 1)
  1808. Sheets("play").Range("Ag1:ak1").Delete
  1809.  
  1810. longrow = Sheets("play").Cells(99, y).End(xlUp).Row
  1811.  
  1812. If Sheets("play").Range(x & longrow).Value = "A" Then aceCount aces
  1813.  
  1814. doubledown_count x, longrow
  1815.  
  1816. For int2 = 5 To longrow
  1817.  
  1818. card = Sheets("play").Range(x & int2).Value
  1819.  
  1820. If Sheets("play").Range(x & int2).Value = "J" Then card = 10
  1821. If Sheets("play").Range(x & int2).Value = "Q" Then card = 10
  1822. If Sheets("play").Range(x & int2).Value = "K" Then card = 10
  1823. If Sheets("play").Range(x & int2).Value = "A" Then card = 11
  1824.  
  1825. cardcount = cardcount + card
  1826. longrow = Sheets("play").Cells(99, y).End(xlUp).Row
  1827.  
  1828. If cardcount > 21 And aces > 0 Then cardcount = cardcount - 10: aces = aces - 1
  1829.  
  1830. DoEvents
  1831. Next int2
  1832.  
  1833. Sheets("play").Range(x & 4).Offset(0, 1) = cardcount
  1834. If cardcount > 21 Then Sheets("play").Range(x & longrow + 5).Value = "BUST"
  1835.  
  1836. End Sub
  1837.  
  1838. Sub doubledown_me2(x As String, y As Long, longrow As Long, card As String, cardcount As Long, int2 As Long)
  1839. ' doubledown split
  1840.  
  1841. aces = 0
  1842.  
  1843. longrow = Sheets("play").Cells(99, y).End(xlUp).Row
  1844.  
  1845. Sheets("play").Range(x & 2).Offset(0, -2).Value = Sheets("play").Range(x & 2).Offset(0, -2).Value - Sheets("play").Range(x & 3).Value
  1846. Sheets("play").Range(x & 3).Value = Sheets("play").Range(x & 3).Value + Sheets("play").Range(x & 3).Value
  1847.  
  1848. For int2 = 5 To 6
  1849. If Sheets("play").Range(x & int2).Value = "A" Then aceCount aces
  1850. Next
  1851.  
  1852. bCard = Sheets("play").Range("AG1").Value
  1853. cRow = longrow + 1
  1854. cCol = y
  1855. InsertImage bCard, cRow, cCol
  1856.  
  1857. Sheets("play").Range("Aj1:ak1").Copy Sheets("play").Range(x & longrow + 1)
  1858. Sheets("play").Range("Ag1:ak1").Delete
  1859.  
  1860. longrow = Sheets("play").Cells(99, y).End(xlUp).Row
  1861.  
  1862. If Sheets("play").Range(x & longrow).Value = "A" Then aceCount aces
  1863.  
  1864. doubledown_count x, longrow
  1865.  
  1866. For int2 = 5 To longrow
  1867.  
  1868. card = Sheets("play").Range(x & int2).Value
  1869.  
  1870. If Sheets("play").Range(x & int2).Value = "J" Then card = 10
  1871. If Sheets("play").Range(x & int2).Value = "Q" Then card = 10
  1872. If Sheets("play").Range(x & int2).Value = "K" Then card = 10
  1873. If Sheets("play").Range(x & int2).Value = "A" Then card = 11
  1874.  
  1875. cardcount = cardcount + card
  1876. longrow = Sheets("play").Cells(99, y).End(xlUp).Row
  1877.  
  1878. If cardcount > 21 And aces > 0 Then cardcount = cardcount - 10: aces = aces - 1
  1879. DoEvents
  1880. Next int2
  1881. Sheets("play").Range(x & 4).Offset(0, 1) = cardcount
  1882. If cardcount > 21 Then Sheets("play").Range(x & longrow + 5).Value = "BUST"
  1883.  
  1884. End Sub
  1885.  
  1886. Sub doubledown_count(x As String, longrow As Long) 'doubledown runningcount
  1887. If Sheets("play").Range(x & longrow).Value = "A" Then Sheets("play").Range("AD3").Value = Sheets("play").Range("AD3").Value + 1
  1888. If Sheets("play").Range(x & longrow).Value = "K" Then Sheets("play").Range("AD2").Value = Sheets("play").Range("AD2").Value + 1
  1889. If Sheets("play").Range(x & longrow).Value = "Q" Then Sheets("play").Range("AD2").Value = Sheets("play").Range("AD2").Value + 1
  1890. If Sheets("play").Range(x & longrow).Value = "J" Then Sheets("play").Range("AD2").Value = Sheets("play").Range("AD2").Value + 1
  1891. If Sheets("play").Range(x & longrow).Value = "10" Then Sheets("play").Range("AD2").Value = Sheets("play").Range("AD2").Value + 1
  1892. If Sheets("play").Range(x & longrow).Value = "2" Then Sheets("play").Range("AD4").Value = Sheets("play").Range("AD4").Value + 1
  1893. If Sheets("play").Range(x & longrow).Value = "3" Then Sheets("play").Range("AD4").Value = Sheets("play").Range("AD4").Value + 1
  1894. If Sheets("play").Range(x & longrow).Value = "4" Then Sheets("play").Range("AD4").Value = Sheets("play").Range("AD4").Value + 1
  1895. If Sheets("play").Range(x & longrow).Value = "5" Then Sheets("play").Range("AD4").Value = Sheets("play").Range("AD4").Value + 1
  1896. If Sheets("play").Range(x & longrow).Value = "6" Then Sheets("play").Range("AD4").Value = Sheets("play").Range("AD4").Value + 1
  1897. End Sub
  1898.  
  1899. Sub Finish()
  1900. 'finish1
  1901.  
  1902. End Sub
  1903.  
  1904. Sub hit()
  1905. 'hit1
  1906.  
  1907. Dim x As String, y As Long, longrow As Long
  1908.  
  1909. Application.ScreenUpdating = False
  1910.  
  1911. Range("b1").Select
  1912. Do
  1913.     If ActiveCell.Interior.Color = vbGreen Then Exit Do
  1914.     ActiveCell.Offset(0, 1).Select
  1915.     DoEvents
  1916. Loop Until Selection.Address = Sheets("play").Range("ab1").Address
  1917. If Selection.Address = Sheets("play").Range("ab1").Address Then Exit Sub
  1918.  
  1919. If Sheets("play").Range("B1").Interior.Color = vbGreen Then x = "B"
  1920. If Sheets("play").Range("B1").Interior.Color = vbGreen Then y = 2
  1921.  
  1922. If Sheets("play").Range("E1").Interior.Color = vbGreen Then x = "E"
  1923. If Sheets("play").Range("E1").Interior.Color = vbGreen Then y = 5
  1924.  
  1925. If Sheets("play").Range("G1").Interior.Color = vbGreen Then x = "G"
  1926. If Sheets("play").Range("G1").Interior.Color = vbGreen Then y = 7
  1927.  
  1928. If Sheets("play").Range("I1").Interior.Color = vbGreen Then x = "I"  ' player column number
  1929. If Sheets("play").Range("I1").Interior.Color = vbGreen Then y = 9 ' player column
  1930.  
  1931. If Sheets("play").Range("K1").Interior.Color = vbGreen Then x = "K"   ' player column number
  1932. If Sheets("play").Range("K1").Interior.Color = vbGreen Then y = 11 ' player column
  1933.  
  1934. If Sheets("play").Range("M1").Interior.Color = vbGreen Then x = "M"   ' player column number
  1935. If Sheets("play").Range("M1").Interior.Color = vbGreen Then y = 13 ' player column
  1936.  
  1937. If Sheets("play").Range("O1").Interior.Color = vbGreen Then x = "O"   ' player column number
  1938. If Sheets("play").Range("O1").Interior.Color = vbGreen Then y = 15 ' player column
  1939.  
  1940. If Sheets("play").Range("Q1").Interior.Color = vbGreen Then x = "Q"   ' player column number
  1941. If Sheets("play").Range("Q1").Interior.Color = vbGreen Then y = 17 ' player column
  1942.  
  1943. If Sheets("play").Range("S1").Interior.Color = vbGreen Then x = "S"   ' player column number
  1944. If Sheets("play").Range("S1").Interior.Color = vbGreen Then y = 19 ' player column
  1945.  
  1946. If Sheets("play").Range("U1").Interior.Color = vbGreen Then x = "U"   ' player column number
  1947. If Sheets("play").Range("U1").Interior.Color = vbGreen Then y = 21 ' player column
  1948.  
  1949. If Sheets("play").Range("W1").Interior.Color = vbGreen Then x = "W"   ' player column number
  1950. If Sheets("play").Range("W1").Interior.Color = vbGreen Then y = 23 ' player column
  1951.  
  1952. If Sheets("play").Range("Y1").Interior.Color = vbGreen Then x = "Y"   ' player column number
  1953. If Sheets("play").Range("Y1").Interior.Color = vbGreen Then y = 25 ' player column
  1954.  
  1955. If Sheets("play").Range("AA1").Interior.Color = vbGreen Then x = "AA"   ' player column number
  1956. If Sheets("play").Range("AA1").Interior.Color = vbGreen Then y = 27 ' player column
  1957.  
  1958.  
  1959. hit_me x, y, longrow
  1960.  
  1961. Application.ScreenUpdating = True
  1962.  
  1963. End Sub
  1964.  
  1965. Sub hit_me(x As String, y As Long, longrow As Long)  'aa As long,
  1966. ' hit
  1967.  
  1968. longrow = Sheets("play").Cells(99, y).End(xlUp).Row
  1969.  
  1970. bCard = Sheets("play").Range("AG1").Value
  1971. cRow = longrow + 1
  1972. cCol = y
  1973. InsertImage bCard, cRow, cCol
  1974.  
  1975. Sheets("play").Range("Aj1:ak1").Copy Sheets("play").Range(x & longrow + 1)
  1976. Sheets("play").Range("Af1:ak1").Delete
  1977.  
  1978. longrow = Sheets("play").Cells(99, y).End(xlUp).Row
  1979.  
  1980. hit_count x, longrow
  1981.  
  1982. End Sub
  1983.  
  1984. Sub hit_count(x As String, longrow As Long) 'hit runningcount
  1985. If Sheets("play").Range(x & longrow).Value = "A" Then Sheets("play").Range("AD3").Value = Sheets("play").Range("AD3").Value + 1
  1986. If Sheets("play").Range(x & longrow).Value = "K" Then Sheets("play").Range("AD2").Value = Sheets("play").Range("AD2").Value + 1
  1987. If Sheets("play").Range(x & longrow).Value = "Q" Then Sheets("play").Range("AD2").Value = Sheets("play").Range("AD2").Value + 1
  1988. If Sheets("play").Range(x & longrow).Value = "J" Then Sheets("play").Range("AD2").Value = Sheets("play").Range("AD2").Value + 1
  1989. If Sheets("play").Range(x & longrow).Value = "10" Then Sheets("play").Range("AD2").Value = Sheets("play").Range("AD2").Value + 1
  1990. If Sheets("play").Range(x & longrow).Value = "2" Then Sheets("play").Range("AD4").Value = Sheets("play").Range("AD4").Value + 1
  1991. If Sheets("play").Range(x & longrow).Value = "3" Then Sheets("play").Range("AD4").Value = Sheets("play").Range("AD4").Value + 1
  1992. If Sheets("play").Range(x & longrow).Value = "4" Then Sheets("play").Range("AD4").Value = Sheets("play").Range("AD4").Value + 1
  1993. If Sheets("play").Range(x & longrow).Value = "5" Then Sheets("play").Range("AD4").Value = Sheets("play").Range("AD4").Value + 1
  1994. If Sheets("play").Range(x & longrow).Value = "6" Then Sheets("play").Range("AD4").Value = Sheets("play").Range("AD4").Value + 1
  1995. End Sub
  1996.  
  1997.  
  1998.  
  1999. Sub stand2()
  2000. 'stand21
  2001.  
  2002. Dim longrow As Long, card As String, cardcount As Long, int5 As Long, int6 As Long, q As Long, p As String
  2003. Dim str1 As String, x As String, a As Long, ffffff As Long, cCard As String, dCard As String, cCell As Long
  2004. Dim ColLet As String, colNum As Long, standCount As Long, RowNum As Long, boo As Boolean
  2005.  
  2006. aces = 0
  2007.  
  2008. Application.ScreenUpdating = False
  2009.  
  2010. Sheets("play").Range("B1").Interior.Color = vbGreen
  2011.  
  2012. longrow = Sheets("play").Range("B" & 99).End(xlUp).Row
  2013.  
  2014. card = Sheets("play").Range("B5").Value
  2015. If card = "A" Then aceCount aces
  2016.     If Sheets("play").Range("B5").Value = "J" Then card = 10
  2017.     If Sheets("play").Range("B5").Value = "Q" Then card = 10
  2018.     If Sheets("play").Range("B5").Value = "K" Then card = 10
  2019.     If Sheets("play").Range("B5").Value = "A" Then card = 11
  2020. cardcount = cardcount + card
  2021.  
  2022. card = Sheets("play").Range("B6").Value
  2023. If card = "A" Then aceCount aces
  2024.     If Sheets("play").Range("B6").Value = "J" Then card = 10
  2025.     If Sheets("play").Range("B6").Value = "Q" Then card = 10
  2026.     If Sheets("play").Range("B6").Value = "K" Then card = 10
  2027.     If Sheets("play").Range("B6").Value = "A" Then card = 11
  2028. cardcount = cardcount + card
  2029.  
  2030. If cardcount > 21 And aces > 0 Then cardcount = cardcount - 10: aces = aces - 1
  2031.  
  2032. 'stand2_count
  2033.  
  2034. longrow = Sheets("play").Range("B" & 99).End(xlUp).Row
  2035.  
  2036. If longrow = 6 And cardcount = 21 Then
  2037.     Sheets("play").Range("C4").Value = 21
  2038.     Sheets("play").Range("B11").Value = "BLACKJACK"
  2039.     Call tally
  2040.     GoTo LABEL
  2041. End If
  2042.  
  2043. If cardcount = 17 And aces > 0 And Sheets("play").Range("C1").Value = "Y" Then
  2044.     ColLet = "B": RowNum = 5: standCount = 18: card = 0
  2045.     colLoop ColLet, RowNum, standCount, cardcount, card
  2046.     Sheets("play").Range("C4").Value = cardcount
  2047.     longrow = Sheets("play").Range("B" & 99).End(xlUp).Row
  2048.     If cardcount > 21 Then Sheets("play").Range("b" & longrow + 5).Value = "BUST": Sheets("play").Range("C4").Value = ""
  2049.     Call tally
  2050.     GoTo LABEL
  2051. End If
  2052.  
  2053. If cardcount < 17 Then
  2054.     ColLet = "B": RowNum = 5: standCount = 17: card = 0
  2055.     colLoop ColLet, RowNum, standCount, cardcount, card
  2056.     Sheets("play").Range("C4").Value = cardcount
  2057.     longrow = Sheets("play").Range("B" & 99).End(xlUp).Row
  2058.     If cardcount > 21 Then Sheets("play").Range("b" & longrow + 5).Value = "BUST": Sheets("play").Range("C4").Value = ""
  2059.     Call tally
  2060.     GoTo LABEL
  2061. End If
  2062.  
  2063. If cardcount >= 17 Then
  2064.     Sheets("play").Range("C4").Value = cardcount
  2065.     Call tally
  2066.     GoTo LABEL
  2067. End If
  2068.  
  2069. LABEL:
  2070. Application.ScreenUpdating = True
  2071.  
  2072. For q = 5 To 27 Step 2
  2073. p = NumbersToColumns(q)
  2074. Sheets("play").Range(p & 1).Interior.Color = RGB(205, 250, 253)
  2075. Next q
  2076.  
  2077. myImage.Visible = True
  2078.  
  2079. End Sub
  2080.  
  2081.  
  2082. Sub tally()
  2083. 'Tally1
  2084. Dim a As Long, x As String, longrow As Long
  2085.  
  2086. Application.ScreenUpdating = False
  2087.  
  2088. For a = 5 To 28 Step 2
  2089.     x = NumbersToColumns(a)
  2090.     If Sheets("play").Range(x & 4).Offset(0, 1) <> "" Then
  2091.         longrow = Sheets("play").Range(x & 99).End(xlUp).Row
  2092.         If Sheets("play").Range(x & longrow).Value = "BLACKJACK" And Sheets("play").Range("B11").Value = "BLACKJACK" Then
  2093.                 If x = "G" Then Sheets("play").Range(x & 2).Offset(0, -2).Value = Sheets("play").Range(x & 2).Offset(0, -2).Value + Sheets("play").Range(x & 3).Value: Sheets("play").Range(x & longrow + 1).Value = "PUSH": GoTo label2
  2094.                 If x = "K" Then Sheets("play").Range(x & 2).Offset(0, -2).Value = Sheets("play").Range(x & 2).Offset(0, -2).Value + Sheets("play").Range(x & 3).Value: Sheets("play").Range(x & longrow + 1).Value = "PUSH": GoTo label2
  2095.                 If x = "O" Then Sheets("play").Range(x & 2).Offset(0, -2).Value = Sheets("play").Range(x & 2).Offset(0, -2).Value + Sheets("play").Range(x & 3).Value: Sheets("play").Range(x & longrow + 1).Value = "PUSH": GoTo label2
  2096.                 If x = "S" Then Sheets("play").Range(x & 2).Offset(0, -2).Value = Sheets("play").Range(x & 2).Offset(0, -2).Value + Sheets("play").Range(x & 3).Value: Sheets("play").Range(x & longrow + 1).Value = "PUSH": GoTo label2
  2097.                 If x = "W" Then Sheets("play").Range(x & 2).Offset(0, -2).Value = Sheets("play").Range(x & 2).Offset(0, -2).Value + Sheets("play").Range(x & 3).Value: Sheets("play").Range(x & longrow + 1).Value = "PUSH": GoTo label2
  2098.                 If x = "AA" Then Sheets("play").Range(x & 2).Offset(0, -2).Value = Sheets("play").Range(x & 2).Offset(0, -2).Value + Sheets("play").Range(x & 3).Value: Sheets("play").Range(x & longrow + 1).Value = "PUSH": GoTo label2
  2099.             Sheets("play").Range(x & longrow + 1).Value = "PUSH"
  2100.             Sheets("play").Range(x & 2).Value = Sheets("play").Range(x & 2).Value + Sheets("play").Range(x & 3).Value
  2101.             GoTo label2
  2102.         End If
  2103.         longrow = Sheets("play").Range(x & 99).End(xlUp).Row
  2104.         If Sheets("play").Range(x & longrow).Value = "BLACKJACK" Then
  2105.             If x = "G" Then Sheets("play").Range(x & 2).Offset(0, -2).Value = Sheets("play").Range(x & 2).Offset(0, -2).Value + Sheets("play").Range(x & 3).Value * 2.5: GoTo label2
  2106.             If x = "K" Then Sheets("play").Range(x & 2).Offset(0, -2).Value = Sheets("play").Range(x & 2).Offset(0, -2).Value + Sheets("play").Range(x & 3).Value * 2.5: GoTo label2
  2107.             If x = "O" Then Sheets("play").Range(x & 2).Offset(0, -2).Value = Sheets("play").Range(x & 2).Offset(0, -2).Value + Sheets("play").Range(x & 3).Value * 2.5: GoTo label2
  2108.             If x = "S" Then Sheets("play").Range(x & 2).Offset(0, -2).Value = Sheets("play").Range(x & 2).Offset(0, -2).Value + Sheets("play").Range(x & 3).Value * 2.5: GoTo label2
  2109.             If x = "W" Then Sheets("play").Range(x & 2).Offset(0, -2).Value = Sheets("play").Range(x & 2).Offset(0, -2).Value + Sheets("play").Range(x & 3).Value * 2.5: GoTo label2
  2110.             If x = "AA" Then Sheets("play").Range(x & 2).Offset(0, -2).Value = Sheets("play").Range(x & 2).Offset(0, -2).Value + Sheets("play").Range(x & 3).Value * 2.5: GoTo label2
  2111.             Sheets("play").Range(x & 2).Value = Sheets("play").Range(x & 2).Value + Sheets("play").Range(x & 3).Value * 2.5: GoTo label2
  2112.         End If
  2113.         If Sheets("play").Range("C4").Value = Sheets("play").Range(x & 4).Offset(0, 1).Value Then
  2114.             longrow = Sheets("play").Range(x & 99).End(xlUp).Row
  2115.             Sheets("play").Range(x & longrow + 5).Value = "PUSH"
  2116.             If x = "G" Then Sheets("play").Range(x & 2).Offset(0, -2).Value = Sheets("play").Range(x & 2).Offset(0, -2).Value + Sheets("play").Range(x & 3).Value: GoTo label2
  2117.             If x = "K" Then Sheets("play").Range(x & 2).Offset(0, -2).Value = Sheets("play").Range(x & 2).Offset(0, -2).Value + Sheets("play").Range(x & 3).Value: GoTo label2
  2118.             If x = "O" Then Sheets("play").Range(x & 2).Offset(0, -2).Value = Sheets("play").Range(x & 2).Offset(0, -2).Value + Sheets("play").Range(x & 3).Value: GoTo label2
  2119.             If x = "S" Then Sheets("play").Range(x & 2).Offset(0, -2).Value = Sheets("play").Range(x & 2).Offset(0, -2).Value + Sheets("play").Range(x & 3).Value: GoTo label2
  2120.             If x = "W" Then Sheets("play").Range(x & 2).Offset(0, -2).Value = Sheets("play").Range(x & 2).Offset(0, -2).Value + Sheets("play").Range(x & 3).Value: GoTo label2
  2121.             If x = "AA" Then Sheets("play").Range(x & 2).Offset(0, -2).Value = Sheets("play").Range(x & 2).Offset(0, -2).Value + Sheets("play").Range(x & 3).Value: GoTo label2
  2122.             Sheets("play").Range(x & 2).Value = Sheets("play").Range(x & 2).Value + Sheets("play").Range(x & 3).Value
  2123.         End If
  2124.         If Sheets("play").Range(x & longrow).Value = "BLACKJACK" Then GoTo label2
  2125.         If Sheets("play").Range("C4").Value < Sheets("play").Range(x & 4).Offset(0, 1).Value And Sheets("play").Range(x & 4).Offset(0, 1).Value < 22 Then
  2126.             longrow = Sheets("play").Range(x & 99).End(xlUp).Row
  2127.             Sheets("play").Range(x & longrow + 5).Value = "WINNER"
  2128.             If x = "G" Then Sheets("play").Range(x & 2).Offset(0, -2).Value = Sheets("play").Range(x & 2).Offset(0, -2).Value + Sheets("play").Range(x & 3).Value * 2: GoTo label2
  2129.             If x = "K" Then Sheets("play").Range(x & 2).Offset(0, -2).Value = Sheets("play").Range(x & 2).Offset(0, -2).Value + Sheets("play").Range(x & 3).Value * 2: GoTo label2
  2130.             If x = "O" Then Sheets("play").Range(x & 2).Offset(0, -2).Value = Sheets("play").Range(x & 2).Offset(0, -2).Value + Sheets("play").Range(x & 3).Value * 2: GoTo label2
  2131.             If x = "S" Then Sheets("play").Range(x & 2).Offset(0, -2).Value = Sheets("play").Range(x & 2).Offset(0, -2).Value + Sheets("play").Range(x & 3).Value * 2: GoTo label2
  2132.             If x = "W" Then Sheets("play").Range(x & 2).Offset(0, -2).Value = Sheets("play").Range(x & 2).Offset(0, -2).Value + Sheets("play").Range(x & 3).Value * 2: GoTo label2
  2133.             If x = "AA" Then Sheets("play").Range(x & 2).Offset(0, -2).Value = Sheets("play").Range(x & 2).Offset(0, -2).Value + Sheets("play").Range(x & 3).Value * 2: GoTo label2
  2134.             Sheets("play").Range(x & 2).Value = Sheets("play").Range(x & 2).Value + Sheets("play").Range(x & 3).Value * 2
  2135.         End If
  2136. label2:
  2137.        
  2138.     End If
  2139.     DoEvents
  2140. Next a
  2141. aces = 0
  2142.  
  2143.  
  2144. stand2_count
  2145.  
  2146. Application.ScreenUpdating = True
  2147.  
  2148.  
  2149. End Sub
  2150.  
  2151. Sub stand2_count()
  2152. If Sheets("play").Range("b5").Value = "A" Then Sheets("play").Range("AD3").Value = Sheets("play").Range("AD3").Value + 1
  2153. If Sheets("play").Range("b5").Value = "K" Then Sheets("play").Range("AD2").Value = Sheets("play").Range("AD2").Value + 1
  2154. If Sheets("play").Range("b5").Value = "Q" Then Sheets("play").Range("AD2").Value = Sheets("play").Range("AD2").Value + 1
  2155. If Sheets("play").Range("b5").Value = "J" Then Sheets("play").Range("AD2").Value = Sheets("play").Range("AD2").Value + 1
  2156. If Sheets("play").Range("b5").Value = "10" Then Sheets("play").Range("AD2").Value = Sheets("play").Range("AD2").Value + 1
  2157. If Sheets("play").Range("b5").Value = "2" Then Sheets("play").Range("AD4").Value = Sheets("play").Range("AD4").Value + 1
  2158. If Sheets("play").Range("b5").Value = "3" Then Sheets("play").Range("AD4").Value = Sheets("play").Range("AD4").Value + 1
  2159. If Sheets("play").Range("b5").Value = "4" Then Sheets("play").Range("AD4").Value = Sheets("play").Range("AD4").Value + 1
  2160. If Sheets("play").Range("b5").Value = "5" Then Sheets("play").Range("AD4").Value = Sheets("play").Range("AD4").Value + 1
  2161. If Sheets("play").Range("b5").Value = "6" Then Sheets("play").Range("AD4").Value = Sheets("play").Range("AD4").Value + 1
  2162. If Sheets("play").Range("b6").Value = "A" Then Sheets("play").Range("AD3").Value = Sheets("play").Range("AD3").Value + 1
  2163. If Sheets("play").Range("b6").Value = "K" Then Sheets("play").Range("AD2").Value = Sheets("play").Range("AD2").Value + 1
  2164. If Sheets("play").Range("b6").Value = "Q" Then Sheets("play").Range("AD2").Value = Sheets("play").Range("AD2").Value + 1
  2165. If Sheets("play").Range("b6").Value = "J" Then Sheets("play").Range("AD2").Value = Sheets("play").Range("AD2").Value + 1
  2166. If Sheets("play").Range("b6").Value = "10" Then Sheets("play").Range("AD2").Value = Sheets("play").Range("AD2").Value + 1
  2167. If Sheets("play").Range("b6").Value = "2" Then Sheets("play").Range("AD4").Value = Sheets("play").Range("AD4").Value + 1
  2168. If Sheets("play").Range("b6").Value = "3" Then Sheets("play").Range("AD4").Value = Sheets("play").Range("AD4").Value + 1
  2169. If Sheets("play").Range("b6").Value = "4" Then Sheets("play").Range("AD4").Value = Sheets("play").Range("AD4").Value + 1
  2170. If Sheets("play").Range("b6").Value = "5" Then Sheets("play").Range("AD4").Value = Sheets("play").Range("AD4").Value + 1
  2171. If Sheets("play").Range("b6").Value = "6" Then Sheets("play").Range("AD4").Value = Sheets("play").Range("AD4").Value + 1
  2172. End Sub
  2173.  
  2174. Sub insurance()
  2175.  
  2176. Dim a As Long, x As Long, y As String, result As Byte
  2177. 'Application.ScreenUpdating = False
  2178.  
  2179. For a = 5 To 27 Step 2
  2180.        
  2181.         y = NumbersToColumns(a)
  2182.         If Sheets("play").Range(y & 3).Value = "" Then GoTo LABEL
  2183.        
  2184.     If Sheets("play").Range("h1").Value = "Y" And Sheets("play").Range("ad6").Value >= 3 Then GoTo label2
  2185.     If Sheets("play").Range("h1").Value = "Y" And Sheets("play").Range("ad6").Value <= 3 Then GoTo LABEL
  2186.    
  2187.     result = MsgBox("Insurance?", vbYesNo)
  2188.  
  2189.     If result = 6 Then
  2190. label2:
  2191.     Sheets("play").Range(y & 2).Value = Sheets("play").Range(y & 2).Value - Sheets("play").Range(y & 3).Value * 0.5
  2192.     Sheets("play").Range(y & 3).Value = Sheets("play").Range(y & 3).Value + Sheets("play").Range(y & 3).Value * 0.5
  2193.     Sheets("play").Range(y & 7).Value = "Insurance"
  2194.    
  2195.     End If
  2196.  
  2197. LABEL:
  2198. DoEvents
  2199. Next a
  2200. 'Application.ScreenUpdating = True
  2201. End Sub
  2202.  
  2203. Sub CardCounter(card As String, cardcount As Long, ColLet, RowNum)
  2204. 'cardcounter1
  2205.  
  2206. Dim longrow As Long
  2207.  
  2208. longrow = Sheets("play").Range(ColLet & 99).End(xlUp).Row
  2209.         cardcount = 0
  2210.         card = 0
  2211.         RowNum = 5
  2212.     Do Until Sheets("play").Range(ColLet & RowNum).Value = ""
  2213.         If Sheets("play").Range(ColLet & RowNum).Value = "A" Then aceCount aces
  2214.         If Sheets("play").Range(ColLet & RowNum).Value = "A" Then card = 11
  2215.         If Sheets("play").Range(ColLet & RowNum).Value = "K" Then card = 10
  2216.         If Sheets("play").Range(ColLet & RowNum).Value = "Q" Then card = 10
  2217.         If Sheets("play").Range(ColLet & RowNum).Value = "J" Then card = 10
  2218.         If Sheets("play").Range(ColLet & RowNum).Value = 10 Then card = 10
  2219.         If Sheets("play").Range(ColLet & RowNum).Value = 9 Then card = 9
  2220.         If Sheets("play").Range(ColLet & RowNum).Value = 8 Then card = 8
  2221.         If Sheets("play").Range(ColLet & RowNum).Value = 7 Then card = 7
  2222.         If Sheets("play").Range(ColLet & RowNum).Value = 6 Then card = 6
  2223.         If Sheets("play").Range(ColLet & RowNum).Value = 5 Then card = 5
  2224.         If Sheets("play").Range(ColLet & RowNum).Value = 4 Then card = 4
  2225.         If Sheets("play").Range(ColLet & RowNum).Value = 3 Then card = 3
  2226.         If Sheets("play").Range(ColLet & RowNum).Value = 2 Then card = 2
  2227.        
  2228.         If cardcount > 21 And aces > 0 Then cardcount = cardcount - 10: aces = aces - 1
  2229.        
  2230.         cardcount = cardcount + card
  2231.         RowNum = RowNum + 1
  2232.        
  2233.     DoEvents
  2234.     Loop
  2235. End Sub
  2236.  
  2237. Sub stand()
  2238. 'stand1
  2239.  
  2240. Dim x As Long, y As String, z As String, aa As Long
  2241. Dim longrow As Long, int2 As Long, card As String, cardcount As Long
  2242. Application.ScreenUpdating = False
  2243.  
  2244. Range("e1").Select
  2245. Do
  2246.     If ActiveCell.Interior.Color = vbGreen Then Exit Do
  2247.     ActiveCell.Offset(0, 1).Select
  2248.     DoEvents
  2249. Loop Until Selection.Address = Sheets("play").Range("ab1").Address
  2250. If Selection.Address = Sheets("play").Range("ab1").Address Then Exit Sub
  2251.  
  2252. If Sheets("play").Range("E1").Interior.Color = vbGreen Then x = 5   ' player column number
  2253. If Sheets("play").Range("E1").Interior.Color = vbGreen Then y = "E" ' player column
  2254.  
  2255. If Sheets("play").Range("G1").Interior.Color = vbGreen Then x = 7   ' player column number
  2256. If Sheets("play").Range("G1").Interior.Color = vbGreen Then y = "G" ' player column
  2257.  
  2258. If Sheets("play").Range("I1").Interior.Color = vbGreen Then x = 9   ' player column number
  2259. If Sheets("play").Range("I1").Interior.Color = vbGreen Then y = "I" ' player column
  2260.  
  2261. If Sheets("play").Range("K1").Interior.Color = vbGreen Then x = 11   ' player column number
  2262. If Sheets("play").Range("K1").Interior.Color = vbGreen Then y = "K" ' player column
  2263.  
  2264. If Sheets("play").Range("M1").Interior.Color = vbGreen Then x = 13   ' player column number
  2265. If Sheets("play").Range("M1").Interior.Color = vbGreen Then y = "M" ' player column
  2266.  
  2267. If Sheets("play").Range("O1").Interior.Color = vbGreen Then x = 15   ' player column number
  2268. If Sheets("play").Range("O1").Interior.Color = vbGreen Then y = "O" ' player column
  2269.  
  2270. If Sheets("play").Range("Q1").Interior.Color = vbGreen Then x = 17   ' player column number
  2271. If Sheets("play").Range("Q1").Interior.Color = vbGreen Then y = "Q" ' player column
  2272.  
  2273. If Sheets("play").Range("S1").Interior.Color = vbGreen Then x = 19   ' player column number
  2274. If Sheets("play").Range("S1").Interior.Color = vbGreen Then y = "S" ' player column
  2275.  
  2276. If Sheets("play").Range("U1").Interior.Color = vbGreen Then x = 21   ' player column number
  2277. If Sheets("play").Range("U1").Interior.Color = vbGreen Then y = "U" ' player column
  2278.  
  2279. If Sheets("play").Range("W1").Interior.Color = vbGreen Then x = 23   ' player column number
  2280. If Sheets("play").Range("W1").Interior.Color = vbGreen Then y = "W" ' player column
  2281.  
  2282. If Sheets("play").Range("Y1").Interior.Color = vbGreen Then x = 25   ' player column number
  2283. If Sheets("play").Range("Y1").Interior.Color = vbGreen Then y = "Y" ' player column
  2284.  
  2285. If Sheets("play").Range("AA1").Interior.Color = vbGreen Then x = 27   ' player column number
  2286. If Sheets("play").Range("AA1").Interior.Color = vbGreen Then y = "AA" ' player column
  2287.  
  2288. If Sheets("play").Range("E5").Value = "" Then MsgBox ("You have not bet yet"): Exit Sub
  2289. On Error Resume Next
  2290. stand_me longrow, int2, card, cardcount, y, x
  2291. On Error Resume Next
  2292. stand_me2 longrow, int2, card, cardcount, z, aa
  2293.  
  2294. Application.ScreenUpdating = True
  2295.  
  2296.  
  2297. aces = 0
  2298.  
  2299. Dim p As String, q As Long
  2300. For q = 5 To 27 Step 2
  2301. p = NumbersToColumns(q)
  2302. Sheets("play").Range(p & 1).Interior.Color = RGB(205, 250, 253)
  2303. Next q
  2304.  
  2305. If Sheets("play").Cells(3, x).End(xlToRight).Column = 7 Then player1_split: Exit Sub
  2306. If Sheets("play").Cells(3, x).End(xlToRight).Column = 11 Then player2_split: Exit Sub
  2307. If Sheets("play").Cells(3, x).End(xlToRight).Column = 15 Then player3_split: Exit Sub
  2308. If Sheets("play").Cells(3, x).End(xlToRight).Column = 19 Then player4_split: Exit Sub
  2309. If Sheets("play").Cells(3, x).End(xlToRight).Column = 23 Then player5_split: Exit Sub
  2310. If Sheets("play").Cells(3, x).End(xlToRight).Column = 27 Then player6_split: Exit Sub
  2311.  
  2312. If Sheets("play").Cells(3, x).End(xlToRight).Column = 9 Then player2: Exit Sub
  2313. If Sheets("play").Cells(3, x).End(xlToRight).Column = 13 Then player3: Exit Sub
  2314. If Sheets("play").Cells(3, x).End(xlToRight).Column = 17 Then player4: Exit Sub
  2315. If Sheets("play").Cells(3, x).End(xlToRight).Column = 21 Then player5: Exit Sub
  2316. If Sheets("play").Cells(3, x).End(xlToRight).Column = 25 Then player6: Exit Sub
  2317.  
  2318. stand2
  2319.  
  2320. End Sub
  2321.  
  2322. Sub stand_me(longrow As Long, int2 As Long, card As String, cardcount As Long, y As String, x As Long)
  2323. ' standme1
  2324.  
  2325. aces = 0
  2326.  
  2327. longrow = Sheets("play").Cells(99, x).End(xlUp).Row
  2328.  
  2329. For int2 = 5 To longrow
  2330. If Sheets("play").Range(y & int2).Value = "A" Then aceCount aces
  2331. Next
  2332.  
  2333. For int2 = 5 To longrow
  2334.  
  2335.     card = Sheets("play").Range(y & int2).Value
  2336.  
  2337.     If Sheets("play").Range(y & int2).Value = "J" Then card = 10
  2338.     If Sheets("play").Range(y & int2).Value = "Q" Then card = 10
  2339.     If Sheets("play").Range(y & int2).Value = "K" Then card = 10
  2340.     If Sheets("play").Range(y & int2).Value = "A" Then card = 11
  2341.  
  2342.     cardcount = cardcount + card
  2343.     If int2 = 6 And cardcount = 21 Then
  2344.         Sheets("play").Range(y & longrow + 5).Value = "BLACKJACK": GoTo LABEL
  2345.     End If
  2346.     If cardcount > 21 And aces > 0 Then cardcount = cardcount - 10: aces = aces - 1
  2347.     If cardcount > 21 And aces > 0 Then cardcount = cardcount - 10: aces = aces - 1
  2348. DoEvents
  2349. label2:
  2350. Next int2
  2351.  
  2352. LABEL:
  2353. longrow = Sheets("play").Cells(99, x).End(xlUp).Row
  2354. Sheets("play").Range(y & 4).Offset(0, 1) = cardcount
  2355. If cardcount > 21 Then Sheets("play").Range(y & longrow + 5).Value = "BUST"
  2356.  
  2357. End Sub
  2358.  
  2359. Sub stand_me2(longrow As Long, int2 As Long, card As String, cardcount As Long, z As String, aa As Long)
  2360. ' standme2
  2361.  
  2362. aces = 0
  2363.  
  2364. longrow = Sheets("play").Cells(99, aa).End(xlUp).Row
  2365.  
  2366. For int2 = 5 To longrow
  2367. If Sheets("play").Range(z & int2).Value = "A" Then aceCount aces
  2368. Next
  2369.  
  2370. For int2 = 5 To longrow
  2371.  
  2372.     card = Sheets("play").Range(z & int2).Value
  2373.  
  2374.     If Sheets("play").Range(z & int2).Value = "J" Then card = 10
  2375.     If Sheets("play").Range(z & int2).Value = "Q" Then card = 10
  2376.     If Sheets("play").Range(z & int2).Value = "K" Then card = 10
  2377.     If Sheets("play").Range(z & int2).Value = "A" Then card = 11
  2378.  
  2379.     cardcount = cardcount + card
  2380.     If int2 = 6 And cardcount = 21 Then
  2381.         Sheets("play").Range(z & longrow + 5).Value = "BLACKJACK": GoTo LABEL
  2382.     End If
  2383.     If cardcount > 21 And aces > 0 Then cardcount = cardcount - 10: aces = aces - 1
  2384.     If cardcount > 21 And aces > 0 Then cardcount = cardcount - 10: aces = aces - 1
  2385. DoEvents
  2386. label2:
  2387. Next int2
  2388. If cardcount > 21 Then Sheets("play").Range(z & longrow + 5).Value = "BUST"
  2389.  
  2390.  
  2391. LABEL:
  2392. Sheets("play").Range(z & 4).Offset(0, 1) = cardcount
  2393. End Sub
  2394.  
  2395.  
  2396. Sub surrender()
  2397. 'surrender1
  2398.  
  2399. Dim x As String, y As Long
  2400.  
  2401. Application.ScreenUpdating = False
  2402.  
  2403. Range("e1").Select
  2404. Do
  2405.     If ActiveCell.Interior.Color = vbGreen Then Exit Do
  2406.     ActiveCell.Offset(0, 1).Select
  2407.     DoEvents
  2408. Loop Until Selection.Address = Sheets("play").Range("ab1").Address
  2409. If Selection.Address = Sheets("play").Range("ab1").Address Then Exit Sub
  2410.  
  2411. If Sheets("play").Range("E1").Interior.Color = vbGreen Then x = "E"   ' player column number
  2412. If Sheets("play").Range("E1").Interior.Color = vbGreen Then y = 5 ' player column
  2413.  
  2414. If Sheets("play").Range("G1").Interior.Color = vbGreen Then x = "G"   ' player column number
  2415. If Sheets("play").Range("G1").Interior.Color = vbGreen Then y = 7 ' player column
  2416.  
  2417. If Sheets("play").Range("I1").Interior.Color = vbGreen Then x = "I"  ' player column number
  2418. If Sheets("play").Range("I1").Interior.Color = vbGreen Then y = 9 ' player column
  2419.  
  2420. If Sheets("play").Range("K1").Interior.Color = vbGreen Then x = "K"   ' player column number
  2421. If Sheets("play").Range("K1").Interior.Color = vbGreen Then y = 11 ' player column
  2422.  
  2423. If Sheets("play").Range("M1").Interior.Color = vbGreen Then x = "M"   ' player column number
  2424. If Sheets("play").Range("M1").Interior.Color = vbGreen Then y = 13 ' player column
  2425.  
  2426. If Sheets("play").Range("O1").Interior.Color = vbGreen Then x = "O"   ' player column number
  2427. If Sheets("play").Range("O1").Interior.Color = vbGreen Then y = 15 ' player column
  2428.  
  2429. If Sheets("play").Range("Q1").Interior.Color = vbGreen Then x = "Q"   ' player column number
  2430. If Sheets("play").Range("Q1").Interior.Color = vbGreen Then y = 17 ' player column
  2431.  
  2432. If Sheets("play").Range("S1").Interior.Color = vbGreen Then x = "S"   ' player column number
  2433. If Sheets("play").Range("S1").Interior.Color = vbGreen Then y = 19 ' player column
  2434.  
  2435. If Sheets("play").Range("U1").Interior.Color = vbGreen Then x = "U"   ' player column number
  2436. If Sheets("play").Range("U1").Interior.Color = vbGreen Then y = 21 ' player column
  2437.  
  2438. If Sheets("play").Range("W1").Interior.Color = vbGreen Then x = "W"   ' player column number
  2439. If Sheets("play").Range("W1").Interior.Color = vbGreen Then y = 3 ' player column
  2440.  
  2441. If Sheets("play").Range("Y1").Interior.Color = vbGreen Then x = "Y"   ' player column number
  2442. If Sheets("play").Range("Y1").Interior.Color = vbGreen Then y = 25 ' player column
  2443.  
  2444. If Sheets("play").Range("AA1").Interior.Color = vbGreen Then x = "AA"   ' player column number
  2445. If Sheets("play").Range("AA1").Interior.Color = vbGreen Then y = 27 ' player column
  2446.  
  2447.  
  2448.  
  2449. If Sheets("play").Range("E1").Interior.Color = vbGreen Then
  2450.     Sheets("play").Range(x & 2).Value = Sheets("play").Range(x & 2).Value + Sheets("play").Range(x & 3).Value * 0.5
  2451.     Sheets("play").Range(x & 3).ClearContents
  2452. End If
  2453.  
  2454. If Sheets("play").Range("I1").Interior.Color = vbGreen Then
  2455.     Sheets("play").Range(x & 2).Value = Sheets("play").Range(x & 2).Value + Sheets("play").Range(x & 3).Value * 0.5
  2456.     Sheets("play").Range(x & 3).ClearContents
  2457. End If
  2458.  
  2459. If Sheets("play").Range("M1").Interior.Color = vbGreen Then
  2460.     Sheets("play").Range(x & 2).Value = Sheets("play").Range(x & 2).Value + Sheets("play").Range(x & 3).Value * 0.5
  2461.     Sheets("play").Range(x & 3).ClearContents
  2462. End If
  2463.  
  2464.  
  2465. If Sheets("play").Range("Q1").Interior.Color = vbGreen Then
  2466.     Sheets("play").Range(x & 2).Value = Sheets("play").Range(x & 2).Value + Sheets("play").Range(x & 3).Value * 0.5
  2467.     Sheets("play").Range(x & 3).ClearContents
  2468. End If
  2469.  
  2470. If Sheets("play").Range("U1").Interior.Color = vbGreen Then
  2471.     Sheets("play").Range(x & 2).Value = Sheets("play").Range(x & 2).Value + Sheets("play").Range(x & 3).Value * 0.5
  2472.     Sheets("play").Range(x & 3).ClearContents
  2473. End If
  2474.  
  2475. If Sheets("play").Range("Y1").Interior.Color = vbGreen Then
  2476.     Sheets("play").Range(x & 2).Value = Sheets("play").Range(x & 2).Value + Sheets("play").Range(x & 3).Value * 0.5
  2477.     Sheets("play").Range(x & 3).ClearContents
  2478. End If
  2479.  
  2480. If Sheets("play").Range("G1").Interior.Color = vbGreen Then
  2481.     Sheets("play").Range(x & 2).Offset(0, -2).Value = Sheets("play").Range(x & 2).Offset(0, -2).Value + Sheets("play").Range(x & 3).Value * 0.5
  2482.     Sheets("play").Range(x & 3).ClearContents
  2483. End If
  2484.  
  2485. If Sheets("play").Range("K1").Interior.Color = vbGreen Then
  2486.     Sheets("play").Range(x & 2).Offset(0, -2).Value = Sheets("play").Range(x & 2).Offset(0, -2).Value + Sheets("play").Range(x & 3).Value * 0.5
  2487.     Sheets("play").Range(x & 3).ClearContents
  2488. End If
  2489.  
  2490. If Sheets("play").Range("O1").Interior.Color = vbGreen Then
  2491.     Sheets("play").Range(x & 2).Offset(0, -2).Value = Sheets("play").Range(x & 2).Offset(0, -2).Value + Sheets("play").Range(x & 3).Value * 0.5
  2492.     Sheets("play").Range(x & 3).ClearContents
  2493. End If
  2494.  
  2495. If Sheets("play").Range("S1").Interior.Color = vbGreen Then
  2496.     Sheets("play").Range(x & 2).Offset(0, -2).Value = Sheets("play").Range(x & 2).Offset(0, -2).Value + Sheets("play").Range(x & 3).Value * 0.5
  2497.     Sheets("play").Range(x & 3).ClearContents
  2498. End If
  2499.  
  2500. If Sheets("play").Range("W1").Interior.Color = vbGreen Then
  2501.     Sheets("play").Range(x & 2).Offset(0, -2).Value = Sheets("play").Range(x & 2).Offset(0, -2).Value + Sheets("play").Range(x & 3).Value * 0.5
  2502.     Sheets("play").Range(x & 3).ClearContents
  2503. End If
  2504.  
  2505. If Sheets("play").Range("AA1").Interior.Color = vbGreen Then
  2506.     Sheets("play").Range(x & 2).Offset(0, -2).Value = Sheets("play").Range(x & 2).Offset(0, -2).Value + Sheets("play").Range(x & 3).Value * 0.5
  2507.     Sheets("play").Range(x & 3).ClearContents
  2508. End If
  2509.  
  2510. 'If Sheets("play").Range(x & 3).End(xlToRight).Column = 29 Then
  2511. '
  2512. '    Sheets("play").Range(x & 1).Interior.Color = RGB(205, 250, 253)
  2513. '
  2514. '    stand2
  2515. '
  2516. '    Exit Sub
  2517. 'End If
  2518.  
  2519. stand
  2520. Application.ScreenUpdating = True
  2521.  
  2522. End Sub
  2523.  
  2524.  
  2525.  
  2526.  
  2527. Sub InsertImage(ByVal cCard As String, cRow As Long, cCol As Long) ', dCard As String
  2528. 'insertimage1
  2529.  
  2530. Dim ws As Worksheet
  2531. Set ws = Sheets("play")
  2532. Dim imagePath As String
  2533. Dim imgLeft As Double
  2534. Dim imgTop As Double
  2535. Dim a As Long, b As String
  2536. a = Cells(14, 1).Value
  2537. b = Cells(14, 2).Value
  2538. Set ws = ActiveSheet
  2539.  
  2540. 'PUT IN CARD PATH HERE BETWEEN THE FIRST 2 QUOTES:
  2541. imagePath = ws.Cells(20, 1).Value & "\" & cCard & ".png"
  2542. 'YOU CAN GET RID OF ENVIRON("userprofile") IF YOU WANT, I HAVE MORE THAT ONE COMP... THAT'S WHY I GOT IT THERE
  2543.  
  2544. imgLeft = Sheets("play").Cells(cRow, cCol).Left
  2545. imgTop = Sheets("play").Cells(cRow, cCol).Top
  2546.  
  2547. 'Width & Height = -1 means keep original size
  2548. ws.Shapes.AddPicture _
  2549.     Filename:=imagePath, _
  2550.     LinkToFile:=msoFalse, _
  2551.     SaveWithDocument:=msoTrue, _
  2552.     Left:=imgLeft, _
  2553.     Top:=imgTop, _
  2554.     Width:=50, _
  2555.     Height:=83
  2556.    
  2557.  'C:\Users\Administrator1\OneDrive\excel\cards
  2558. 'sheets("play").Cells(5, 2) = myImage.Visible = msoFalse
  2559. 'C:\Users\actor\OneDrive\excel\cards
  2560. 'Environ("userprofile") & "\OneDrive\excel\cards"
  2561. End Sub
  2562.  
  2563.  
  2564.  
  2565.  
  2566.  
  2567.  
  2568.  
Add Comment
Please, Sign In to add comment
Public Pastes
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!