auto Rotating large list of numbers

[walkster220]

hi everyone, need need some help auto rotating a large list of win3 and win4 lottery numbers.....

each digit position has a rotation pattern full independent of one another p1-p2-p3 or p1-p2-p3-p4 as a new digit takes the place place of the previous digit with each new draw .digits that were hot(top) eventually shift to cold(bottom)..when a new digit is drawn the previous digits shifts down..if the new digit drawn in that position repeats all digits in that position remain the same... how can i do this for suck a large list i want to border them also

lottery list
11/19/16 5221 (starting Point)
11/20/16 7062
11/21/16 6758
11/22/16

etc

<tbody>
</tbody>

5 2 2 1 7 0 6 2 6 7 5 8 2 3 7 7 5 2 2 1 7 0 6 2 3 6 0 3 2 3 7 7 5 2 2 1 0 5 5 9 3 6 0 3 2 3 7 7 7 4 4 6 0 5 5 9 3 6 0 3 6 9 8 4 6 4 4 6 0 5 4 9 1 0 9 8 1 9 8 4 1 4 8 6 8 8 1 2 8 8 9 8 8 9 9 4 4 1 3 0 4 1 1 0 4 8 1 0 9 7 6 5 9 7 3 5 9 1 3 5 <tbody> </tbody> <tbody> </tbody>

<tbody>
</tbody>

 

[rpaulson]

can probably help you out, but Im clueless on what you are actually trying to accomplish?

 

[walkster220]

i know lol i explained that pretty bad forgive me... the 4 rows of digits represent the 1 column with a distribution of digit 0-9 in each position of the win game ..

5221 hit 11/19/16 the distribution would be the example above the next number to hit was 7602 so the number distribution in each position from the previous draw would shift and adapt to the new one basically ("what goes up must come down" and vice versa) each time a new new digit is drawn in that postion th previously drwan digit shifts down to make room for the new digit... as a new number is drawn the new distribution is created. how can i program excel to create a horizontally forever .the sheet grows as the list grows

 

[rpaulson]

try this on a blank worksheet

Sub do_It()
x = InputBox("Please enter a 4 digit number")

If Not IsNumeric(x) Then
    MsgBox "This is not a  number!"
    Exit Sub
  ElseIf Len(x) <> 4 Then
    MsgBox "Incorrect numbr of digits"
    Exit Sub
  End If

Range("A1").Insert Shift:=xlDown
Range("A1") = Format(x, "'0000")

End Sub

hth,
Ross

 

[walkster220]

[/IMG]

 

[rpaulson]

try this,

Sub do_It()
Application.ScreenUpdating = False
x = InputBox("Please enter a 4 digit number")

If Not IsNumeric(x) Then
    MsgBox "This is not a  number!"
    Exit Sub
  ElseIf Len(x) <> 4 Then
    MsgBox "Incorrect numbr of digits"
    Exit Sub
  End If

'
Range("D4:G15").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("D4:G15").Value = Range("H4:K15").Value

Range("A4").Insert Shift:=xlDown
Range("A4") = Format(x, "'0000")

Range("D4") = Left(x, 1)
Range("E4") = Mid(x, 2, 1)
Range("F4") = Mid(x, 3, 1)
Range("G4") = Right(x, 1)

Range("D4:G4").Copy
Range("D5:G5").Insert Shift:=xlDown

For c = 4 To 7
n = Cells(5, c)
r = WorksheetFunction.Match(n, Range(Cells(6, c), Cells(16, c)), 0) + 5
Cells(r, c).Delete Shift:=xlUp
Next c

Application.ScreenUpdating = True
End Sub

hth,
Ross

 

[walkster220]

its sad i feel so stupid... no matter what material i gather i don't think i'll ever get this VBA thing....the good news this is exactly what i had in my head thank you....
2 questions it possible for the new outcome to go to the right instead of the left.. also is it possible to enter list instead of a single number "enter list"?


im taking a good look at this macro u provided i wanna to see if i can reverse engineer it for pick 3 game on my own.. practice makes perfect once again thank you

 

[rpaulson]

now goes to the right and runs from a list starting in cell A4 and going down

Sub do_It()
Application.ScreenUpdating = False


For rr = 4 To 7 'adjust the range as needed



x = Cells(rr, "A")

If Not IsNumeric(x) Then
    MsgBox "This is not a  number!"
    Exit Sub
ElseIf Len(x) > 4 Then
    MsgBox "Incorrect numbr of digits"
    Exit Sub
End If
x = Format(x, "0000")

wc = Cells(4, Columns.Count).End(xlToLeft).Column + 1

Cells(4, wc) = Left(x, 1)
Cells(4, wc + 1) = Mid(x, 2, 1)
Cells(4, wc + 2) = Mid(x, 3, 1)
Cells(4, wc + 3) = Right(x, 1)

Range(Cells(4, wc), Cells(4, wc + 4)).Copy Range(Cells(5, wc), Cells(5, wc + 4)) 'copy todays number down a row
Range(Cells(5, wc - 4), Cells(14, wc - 1)).Copy Range(Cells(6, wc), Cells(15, wc + 4)) 'copy yesterdays number over to today


For c = wc To wc + 3 ' remove yesterday individual numbers
n = Cells(5, c)
r = WorksheetFunction.Match(n, Range(Cells(6, c), Cells(16, c)), 0) + 5
Cells(r, c).Delete Shift:=xlUp
Next c


Next rr


Application.ScreenUpdating = True
End Sub

Ross

 

[walkster220]

 

[rpaulson]

this should do exactly what you want;

if not feel free to email me directly at

rpaulson
at
ezworks
dot
net

Sub do_It()
Application.ScreenUpdating = False


For rr = 9 To 12 'adjust the range as needed

x = Cells(rr, "A")

If Not IsNumeric(x) Then
    MsgBox "This is not a  number!"
    Exit Sub
ElseIf Len(x) > 4 Then
    MsgBox "Incorrect numbr of digits"
    Exit Sub
End If
x = Format(x, "0000")

wc = Cells(5, Columns.Count).End(xlToLeft).Column + 1

Cells(5, wc) = Left(x, 1)
Cells(5, wc + 1) = Mid(x, 2, 1)
Cells(5, wc + 2) = Mid(x, 3, 1)
Cells(5, wc + 3) = Right(x, 1)


Range(Cells(5, wc), Cells(5, wc + 4)).Copy Range(Cells(7, wc), Cells(7, wc + 4)) 'copy todays number down a row


For c = wc - 4 To wc + -1 'copy over yesterday numbers
For r = 7 To 16

n = Cells(r, c)

y = WorksheetFunction.CountIf(Range(Cells(7, c + 4), Cells(16, c + 4)), n)
If y < 1 Then
wr = Cells(Rows.Count, c + 4).End(xlUp).Row + 1
Cells(wr, c + 4) = n
End If

Next r
Next c

99
Next rr


Application.ScreenUpdating = True
End Sub

Ross