Thank you, sss

[michael168]

Hi ! sss,

Thank you very much for the VBA module. It's really do a great job saving me a lot of time and prevent a lot of typos.

For your info, if I want to extract the result into a new sheet, how to get it done through VBA.

e.g. In the "Data" sheet , col 9

Pattern
A
B
A
C
C
D
E
A
A

Just use single character "A,B,C,D,E....." for ease of typing.
For col 9, may be have to store as arrays because don't know how many patterns exist.

I hope to have a macro to execute from bottom up taking the last row as counter 1 and display in sheet 2 horizontally. Presently I am using the auto filter feature which I cannot view them all at the same same.

e.g. "Result" sheet

A=2,-4,1,-1,1
B=-7,1,-1
C=-4,2-3
D=-3,1,-5
E=-2,1,-6

I would like to have a input box asking how many rows of data I like to compute from bottom up. In this example I using 9 rows.

Let takes "Result" sheet example and check with "Data" sheet data.

A=2 (row 8+row 9=1+1),skip 4 rows (-1x4=-4),1,-1 (skip 1 row),1 (appear again)

Is this possible? Please kindly advise and help.

Regards,
Michael

 

[sss]

Hi ! sss,
Pattern
A
B
A
C
C
D
E
A
A

e.g. "Result" sheet

A=2,-4,1,-1,1
B=-7,1,-1
C=-4,2-3
D=-3,1,-5
E=-2,1,-6

I would like to have a input box asking how many rows of data I like to compute from bottom up. In this example I using 9 rows.
Michael

Hi Michael,

Add
=========
Type myType
Start As Integer
Stop As Integer
End Type
==========
to the Declaration section of your module.
Copy and paste macro2:

==================
Sub macro2()
Dim TotalRows&
Dim RowsToProcess&
Dim DataColumn&
Dim i&, j&, k&, s$
Dim Ar() As String
Dim Item() As myType
Dim Size&
ReDim Ar(0)
'column with source data:
DataColumn = 1

'Max rows to work with
RowsToProcess = 9

TotalRows = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).row

Ar(0) = Cells(1, DataColumn)

'Find size of an array of unique column entries:
For i = 1 To TotalRows
s = Cells(i, DataColumn)
'do we already have such item?
k = UBound(Ar)
For j = 0 To k
If Ar(j) = s Then Exit For
Next
If j > k Then 'new item, insert it into Ar:
k = k + 1
ReDim Preserve Ar(k)
Ar(k) = s
End If
Next

'note: Array starts from "0" index, not from "1"
'If there are 5 items (a,b,c,d,e) the Size will be=4 (from 0 up to 4)
Size = UBound(Ar)

For i = 0 To Size
'get next item from Array:
s = Ar(i)

'Now transform it:
'===========================================================
'find first occurance:
For j = RowsToProcess To 1 Step -1
If Cells(j, DataColumn) = s Then Exit For
Next

'initializing:
ReDim Item(0)
Item(0).Start = RowsToProcess + 1: Item(0).Stop = RowsToProcess + 1

k = 0
Do While j > 0
k = k + 1
ReDim Preserve Item(k)
Item(k).Start = j
Do While Cells(j, DataColumn) = s
Item(k).Stop = j
j = j - 1
If j = 0 Then Exit Do
Loop
If j = 0 Then Exit Do

'skip
Do While Cells(j, DataColumn) <> s
j = j - 1
If j = 0 Then Exit Do
Loop
If j = 0 Then Exit Do
Loop

'final conversion:
s = ""
For j = 1 To k
s = s & Item(j).Start - Item(j - 1).Stop + 1 & ","
s = s & Item(j).Start - Item(j).Stop + 1 & ","
Next
s = s & 1 - Item(k).Stop

'remove leading "0" if any:
If Left(s, 1) = "0" Then s = Mid(s, 3, 100)

'remove trailing "0" if any:
If Right(s, 1) = "0" Then s = Left(s, Len(s) - 2)

'Entries from your DataSheet are written to column 11 ("K")
'Result sequence is written to "L" column
'You can redirect output to whatever location you need, for ex.
'Sheets("AnySheetName").Cells(i + 1, 1) = Ar(i)
'Sheets("Sheet2").Cells(i + 1, 2) = s

Cells(i + 1, 11) = Ar(i)
Cells(i + 1, 12) = s
'===========================================================
Next
End Sub
==================

Number of rows you want to process is hardcoded in
line "RowsToProcess = 9" of macro2.
In order to make it adjustable you have to add form to your
project, place a textbox on that form, also add button and
on button's on_click event put Call macro2
And, finally, instead of "RowsToProcess = 9" use
"RowsToProcess = userform1.textbox1"

Good luck!
sss

 

[peter]

That's what I love about this place.... there is no shortage of people helping others here. 3 sss.

 

[Beaker]

That's what I love about this place.... there is no shortage of people helping others here. 3 sss.

Agreed

Nice work here

 

[Dennis Bassboss]

Nice work...no doubts...A helping hand always get rewarded!!

 

[Matrix]

Une main aidante obtiennent toujours récompensée!!!

 

[michael168]

Re: Re: Thank you, sss

Hi! sss,

12)C C = 3,-2,1,-2,2
11)C A = -4,1,-1,2,-2
10)A B = -3,1,-6
9) C
8) A Above report was generated by the VBA code using the last 10 rows. The result is not correct.
7) B
6) C
5) C The correct result should be as below:
4) C
3) A C = -3,3,-2,1,-1
2) B A = -2,1,-4,1,-1,1
1) B B = 2,-4,1,-3

I try to many times with your code, but the outputs are not correct. So, I post this again for your info. Can the array be sort so that the output will be in ascending order i.e. "A" ,"B","C" ......

Regards,
Michael

Hi Michael,

Add
=========
Type myType
Start As Integer
Stop As Integer
End Type
==========
to the Declaration section of your module.
Copy and paste macro2:

==================
Sub macro2()
Dim TotalRows&
Dim RowsToProcess&
Dim DataColumn&
Dim i&, j&, k&, s$
Dim Ar() As String
Dim Item() As myType
Dim Size&
ReDim Ar(0)
'column with source data:
DataColumn = 1

'Max rows to work with
RowsToProcess = 9

TotalRows = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).row

Ar(0) = Cells(1, DataColumn)

'Find size of an array of unique column entries:
For i = 1 To TotalRows
s = Cells(i, DataColumn)
'do we already have such item?
k = UBound(Ar)
For j = 0 To k
If Ar(j) = s Then Exit For
Next
If j > k Then 'new item, insert it into Ar:
k = k + 1
ReDim Preserve Ar(k)
Ar(k) = s
End If
Next

'note: Array starts from "0" index, not from "1"
'If there are 5 items (a,b,c,d,e) the Size will be=4 (from 0 up to 4)
Size = UBound(Ar)

For i = 0 To Size
'get next item from Array:
s = Ar(i)

'Now transform it:
'===========================================================
'find first occurance:
For j = RowsToProcess To 1 Step -1
If Cells(j, DataColumn) = s Then Exit For
Next

'initializing:
ReDim Item(0)
Item(0).Start = RowsToProcess + 1: Item(0).Stop = RowsToProcess + 1

k = 0
Do While j > 0
k = k + 1
ReDim Preserve Item(k)
Item(k).Start = j
Do While Cells(j, DataColumn) = s
Item(k).Stop = j
j = j - 1
If j = 0 Then Exit Do
Loop
If j = 0 Then Exit Do

'skip
Do While Cells(j, DataColumn) <> s
j = j - 1
If j = 0 Then Exit Do
Loop
If j = 0 Then Exit Do
Loop

'final conversion:
s = ""
For j = 1 To k
s = s & Item(j).Start - Item(j - 1).Stop + 1 & ","
s = s & Item(j).Start - Item(j).Stop + 1 & ","
Next
s = s & 1 - Item(k).Stop

'remove leading "0" if any:
If Left(s, 1) = "0" Then s = Mid(s, 3, 100)

'remove trailing "0" if any:
If Right(s, 1) = "0" Then s = Left(s, Len(s) - 2)

'Entries from your DataSheet are written to column 11 ("K")
'Result sequence is written to "L" column
'You can redirect output to whatever location you need, for ex.
'Sheets("AnySheetName").Cells(i + 1, 1) = Ar(i)
'Sheets("Sheet2").Cells(i + 1, 2) = s

Cells(i + 1, 11) = Ar(i)
Cells(i + 1, 12) = s
'===========================================================
Next
End Sub
==================

Number of rows you want to process is hardcoded in
line "RowsToProcess = 9" of macro2.
In order to make it adjustable you have to add form to your
project, place a textbox on that form, also add button and
on button's on_click event put Call macro2
And, finally, instead of "RowsToProcess = 9" use
"RowsToProcess = userform1.textbox1"

Good luck!
sss

 

[sss]

Re: Re: Re: Thank you, sss

Hi! sss,

12)C C = 3,-2,1,-2,2
11)C A = -4,1,-1,2,-2
10)A B = -3,1,-6
9) C
8) A Above report was generated by the VBA code using the last 10 rows. The result is not correct.
7) B
6) C
5) C The correct result should be as below:
4) C
3) A C = -3,3,-2,1,-1
2) B A = -2,1,-4,1,-1,1
1) B B = 2,-4,1,-3

I try to many times with your code, but the outputs are not correct. So, I post this again for your info. Can the array be sort so that the output will be in ascending order i.e. "A" ,"B","C" ......

Regards,
Michael

Hi Michael,
The line "RowsToProcess = 9" in macro2 sets the number of
rows in a grid to be processed. As it is set to 9 while your list
of patterns (C,C,A,C...) is 12 rows long, results are
different from what you expected. Lines 10 to 12 (in your notation these lines are line 1), line 2) and 3)) just were
ignored. Change RowsToProcess to correct value and you'll
get correct result. For the example above change RowsToProcess = 9 to RowsToProcess = 12, save macro2, and then run it!
Good luck!
sss

 

[michael168]

Re: Re: Re: Re: Thank you, sss

Hi Michael,
The line "RowsToProcess = 9" in macro2 sets the number of
rows in a grid to be processed. As it is set to 9 while your list
of patterns (C,C,A,C...) is 12 rows long, results are
different from what you expected. Lines 10 to 12 (in your notation these lines are line 1), line 2) and 3)) just were
ignored. Change RowsToProcess to correct value and you'll
get correct result. For the example above change RowsToProcess = 9 to RowsToProcess = 12, save macro2, and then run it!
Good luck!
sss

Hi! sss,

You are right if I change the "RowsToProcess = 12" then it gives me the right output. The problem is if in data sheet have few thousand rows and I just want to calculate just the last 200 draws and I change the "RowsToProcess = 200", it still cannot give me the correct output. The reason I do not want to calculate from the last row until the first row is because it makes me hard to have a clearer view of the output.

As in my e.g. using 12 rows of data but changing the "RowsToProcess = 10" cannot give me the correct answer.

Is there a way to solve or must the macro calculate all the rows in order to give the correct answer and can the order in array be sort ?

Regards,
Michael.

 

[sss]

Re: Re: Re: Re: Re: Thank you, sss

Hi! sss,
thousand rows and I just want to calculate just the last 200 draws and I change the "RowsToProcess = 200", it still cannot
Regards,
Michael.

Hi Michael,

Now I see what happens. Macro works with FIRST N records, and
RowsToProcess is a last row of a subset starting from the FIRST row...
Anyway, replace macro2 with this one. Just one thing: macro assumes no blank lines beetween draws and no headers. The very top line should be draw1 data, and so on.
===
Sub macro2()
Dim DataColumn&
Dim i&, j&, k&, s$
Dim Ar() As String
Dim Item() As myType
Dim Size&
ReDim Ar(0)
Dim FirstDraw&, LastDraw&
'column with source data:
DataColumn = 1
LastDraw = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).row

'Max rows to work with
s = InputBox("Apply macro to the LAST draws only. Enter the number of last draws to process:", , 200)
If IsNumeric(s) Then
FirstDraw = LastDraw - CInt(s) + 1
If FirstDraw >= LastDraw Or FirstDraw < 1 Then End
Else
End
End If

Ar(0) = Cells(1, DataColumn)

'Find size of an array of unique column entries:
For i = FirstDraw To LastDraw
s = Cells(i, DataColumn)
'do we already have such item?
k = UBound(Ar)
For j = 0 To k
If Ar(j) = s Then Exit For
Next
If j > k Then 'new item, insert it into Ar:
k = k + 1
ReDim Preserve Ar(k)
Ar(k) = s
End If
Next

Sort2 Ar

'note: Array starts from "0" index, not from "1"
'If there are 5 items (a,b,c,d,e) the Size will be=4 (from 0 up to 4)
Size = UBound(Ar)

For i = 0 To Size
'get next item from Array:
s = Ar(i)

'Now transform it:
'============================================= 'find first occurance:
For j = LastDraw To FirstDraw Step -1
If Cells(j, DataColumn) = s Then Exit For
Next

'initializing:
ReDim Item(0)
Item(0).Start = LastDraw + 1: Item(0).Stop = LastDraw + 1

k = 0
Do While j >= FirstDraw
k = k + 1
ReDim Preserve Item(k)
Item(k).Start = j
Do While Cells(j, DataColumn) = s
Item(k).Stop = j
j = j - 1
If j < FirstDraw Then Exit Do
Loop
If j < FirstDraw Then Exit Do

'skip
Do While Cells(j, DataColumn) <> s
j = j - 1
If j < FirstDraw Then Exit Do
Loop
If j < FirstDraw Then Exit Do
Loop

'final conversion:
s = ""
For j = 1 To k
s = s & Item(j).Start - Item(j - 1).Stop + 1 & ","
s = s & Item(j).Start - Item(j).Stop + 1 & ","
Next
s = s & FirstDraw - Item(k).Stop

'remove leading "0" if any:
If Left(s, 1) = "0" Then s = Mid(s, 3, 100)

'remove trailing "0" if any:
If Right(s, 1) = "0" Then s = Left(s, Len(s) - 2)

'Entries from your DataSheet are written to column 11 ("K")
'Result sequence is written to "L" column
'You can redirect output to whatever location you need, for ex.
'Sheets("AnySheetName").Cells.Cells(i + 1, 1) = Ar(i)
'Sheets("Sheet2").Cells(i + 1, 2) = s

Cells(i + 1, 11) = Ar(i)
Cells(i + 1, 12) = s
'=============================================
Next
End Sub

==========

Also, add new sub to your project:
===
Private Sub Sort2(A As Variant)
Dim B()
Dim i&, j&, itemNo&, ArrLen&
ArrLen = UBound(A)
ReDim B(0 To ArrLen) 'this is a result array B
Dim Mn$

itemNo = -1 'initialising item number

Do
Mn = "Z"
For j = 0 To ArrLen
If A(j) < Mn Then
Mn = A(j)
i = j
End If
Next
itemNo = itemNo + 1
B(itemNo) = Mn
A(i) = "Z"
If itemNo = ArrLen Then Exit Do
Loop

'return sorted:
For i = 0 To ArrLen: A(i) = B(i): Next

End Sub
===

Does it work for you?
sss

 

[michael168]

Hi ! sss,

Your final VBA code works perfectly and I really appreciated your help and the times you spend in helping me.

I must say thank you very much for your helps .

Now I try to learn from your example as I am very new to windows programming.

BTW, is it hard to learn VB/VBA. I have some knowledge on DOS database programming only like Foxpro.

Have you ever write program like lottery wheeling? I mean the program being able to import a text file and do the wheeling like 4if6,5if6 ....

Sorry if I ask to many questions.

Thanks & Regards,
Michael.

 

[sss]

Hi ! sss,

Your final VBA code works perfectly and I really appreciated your help and the times you spend in helping me.

I must say thank you very much for your helps .

Now I try to learn from your example as I am very new to windows programming.

BTW, is it hard to learn VB/VBA. I have some knowledge on DOS database programming only like Foxpro.

Have you ever write program like lottery wheeling? I mean the program being able to import a text file and do the wheeling like 4if6,5if6 ....

Sorry if I ask to many questions.

Thanks & Regards,
Michael.

Hi Michael,
oh yes, I know exactly what you are talking about. When I
switched from DOS programming to Windows, I was desperate
about why the heck that smart guys invented all that Windows,
OOP, tons of APIs etc. What was wrong with so clear, fast,pure,
straightforward, linear DOS programming?
But once you get comprehensive understanding of OOP principles and get used to it you'll find out those guys were not that bad
Now I like Windows programming almost as much as I do
like to drink beer
As for wheeling, I have a wheeling module in my Keno program,
if you want, I'll pull it out from the whole thing and wrap it into
a separate program, add some comments etc, and send you VB source code. If you compare
its output with the LaJolla repository tables you'll find it's doing
a little bit worse (LaJolla tables are about 5% smaller) but I haven't work on wheel optimization yet, it's just a first raw wheel result which surely can be improved. BTW I still dot't understand why people are so crazy about wheels? My opinion is it is absolutely useless... However I incorporated wheeling stuff into the program as people so much like wheels.
Anyway, if you want to work on it and eventually find a way to
improve it, and share your wheel optimization experience, I'll appreciate it.
Good luck!
sss

 

[michael168]

Hi Michael,
oh yes, I know exactly what you are talking about. When I
switched from DOS programming to Windows, I was desperate
about why the heck that smart guys invented all that Windows,
OOP, tons of APIs etc. What was wrong with so clear, fast,pure,
straightforward, linear DOS programming?
But once you get comprehensive understanding of OOP principles and get used to it you'll find out those guys were not that bad
Now I like Windows programming almost as much as I do
like to drink beer
As for wheeling, I have a wheeling module in my Keno program,
if you want, I'll pull it out from the whole thing and wrap it into
a separate program, add some comments etc, and send you VB source code. If you compare
its output with the LaJolla repository tables you'll find it's doing
a little bit worse (LaJolla tables are about 5% smaller) but I haven't work on wheel optimization yet, it's just a first raw wheel result which surely can be improved. BTW I still dot't understand why people are so crazy about wheels? My opinion is it is absolutely useless... However I incorporated wheeling stuff into the program as people so much like wheels.
Anyway, if you want to work on it and eventually find a way to
improve it, and share your wheel optimization experience, I'll appreciate it.
Good luck!
sss

Hi ! sss

Thanks for your infos. I try to understand windows programming slowly and hopefully I can catch it up. If I cannot understand I try to seek for your help if you don't mind.
Great to hear that you do program the lottery wheeling module. As I ask you before, do the current wheeling module accept data import says a text file?

I am interest to have your module and especially with the comments because I can learn and understand better since I am really new to windows programming.

As regards to wheeling, I think the best reason is much more economy. Secondly you still have the chance to capture the jackpot since every set stands equal. The question left behind is how to pick the numbers in the pool and do filtering before apply wheeling.

I have try a free dos wheeling program "Ininuga". It's feature is rich especially I like the 6if7 for pick 6+bonus lottery. But sad to say the program cannot accept/create wheeling for numbers pool exceeding 32 numbers or 8000 lines/sets numbers. According to the author this is the limitation of the dos program.

Sure, I will share my wheel optimization experience once I find somethings.

Looking forward to receive your module. You can send to me at the below address.

mbtu.at.yahoo.dot.com

Good luck to you in the Keno games !

Regards,
Michael.