vba.- Adding Sheets.

[montecarlo2012]

Hello all.

Sub S9_8()
    Dim SrcWS As Worksheet, DestWS As Worksheet
    Dim rngData As Range, cell As Range, M, N
    Dim rngDest As Range, i As Long
    Set SrcWS = Sheet1
':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
    Set DestWS = Sheet9        '::::::LOOP REQUIRE
'::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
    Set rngDest = DestWS.Range("C2")
    For i = 0 To 5
        Set rngData = SrcWS.Range(SrcWS.Cells(2, 2 + i), SrcWS.Cells(SrcWS.Rows.Count, 2 + i).End(xlUp))
        M = -1
        For Each cell In rngData
 '::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
            If cell = 8 Then    ':::::::::::::::::LOOP REQUIRE
'::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
                rngDest.Offset(0, M) = N
                N = 0
                M = M + 1
            Else
                N = N + 1
            End If
        Next cell
        Set rngDest = rngDest.Offset(16)
    Next i
Dim V, Rg As Range
    With Application
        For Each V In Split("B2 B18 B34 B50 B66 B82")
            Set Rg = Range(V, Range(V).End(xlToRight))
            Range(V)(3).Resize(4).Value2 = .Transpose(Array(.Average(Rg), .Count(Rg), .Max(Rg), .Mode(Rg)))
        Next
    End With
            Set Rg = Nothing
'::::::::::::::::::::::::::::::::::::::::::B2::::::::::::::::::::::::::::::::::::::::::::::::::::::
Range("B8").Formula = "=COUNTIF(B2:XX2,B7)" 'QTY MODE
Range("B9").Formula = "=COUNTIF(B2:XX2,B2)"   'QTY LAST
':::::::::::::::::::::::::::::::::::::::::: C 18:::::::::::::::::::::::::::::::::::::::::::::::::::::::
Range("B24").Formula = "=COUNTIF(B18:XX18,B17)" 'QTY MODE
Range("B25").Formula = "=COUNTIF(B18:XX18,B18)"   'QTY LAST
':::::::::::::::::::::::::::::::::::::::::::D34::::::::::::::::::::::::::::::::::::::::::::::::::::::
Range("B40").Formula = "=COUNTIF(B34:XX34,B33)" 'QTY MODE
Range("B41").Formula = "=COUNTIF(B34:XX34,B34)"   'QTY LAST
'.::::::::::::::::::::::::::::::::::::::::E50::::::::::::::::::::::::::::::::::::::::::::::::::::::::
Range("B56").Formula = "=COUNTIF(B50:XX50,B49)" 'QTY MODE
Range("B57").Formula = "=COUNTIF(B50:XX50,B50)"   'QTY LAST
'::::::::::::::::::::::::::::::::::::::::::F66::::::::::::::::::::::::::::::::::::::::::::::::::::::
Range("B72").Formula = "=COUNTIF(B66:XX66,B65)" 'QTY MODE
Range("B73").Formula = "=COUNTIF(B66:XX66,B66)"   'QTY LAST
':::::::::::::::::::::::::::::::::::::::::::G82:::::::::::::::::::::::::::::::::::::::::::::::::::
Range("B88").Formula = "=COUNTIF(B82:XX82,B81)" 'QTY MODE
Range("B89").Formula = "=COUNTIF(B82:XX82,B82)"   'QTY LAST
'::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
Sheet1.Range("L9").Value = Sheet9.Range("B2").Value 'LAST GAME
Sheet1.Range("N9").Value = Sheet9.Range("B7").Value  'MODE
Sheet1.Range("O9").Value = Sheet9.Range("B24").Value  'PRINT QTY  MODE
Sheet1.Range("k9").Value = Sheet9.Range("B25").Value  'PRINT QTY LAST
End Sub

There are two comments in this code that said 'LOOP REQUIRE'
because, what I am doing now is adding a sheet and inserted a new module
and copy and paste again and again the same code.
in the sub ►"Sub S9_8()◄ meaning sheet9 report number 8 etc. etc.

every time that the ►> If cell = 8 Then ◄ change the number I change the sheet, like this:

So the question is, how to loop or avoid this
I have to open 53 sheets in order to see the report on each number
how to do this one time instead of 53 times.

your feedback is important
thank you for reading this.

 

[montecarlo2012]

well I found how to avoid the error
I just move this line

Set rngDest = DestWS.Range("C2")

so the code now in running
But
do not add any sheet
and of course do not repeat the code

 

[montecarlo2012]

now the code is like

Option Explicit
Sub interval_report()
Dim SrcWS As Worksheet, DestWS As Worksheet
Dim rngData As Range, cell As Range
Dim i As Long, M As Long, N As Long
Dim rngDest As Range

Set SrcWS = Sheet3


            For Each DestWS In ActiveWorkbook.Worksheets
                  If DestWS.CodeName <> "Sheet3" Then
                  Set rngDest = DestWS.Range("C2")
                              For i = 0 To 5
                                          Set rngData = SrcWS.Range(SrcWS.Cells(2, 2 + i), SrcWS.Cells(SrcWS.Rows.Count, 2 + i).End(xlUp))

 

[montecarlo2012]

So now what I did.
I opened manually two more sheets, but I didn't get different results, all sheets got the same value and that, it is not the idea,

 

[Alex Blakenburg]

You need to provide an xl2bb of what I assume is sheet3 and explain how
1) it's determining when to create a new sheet and what to call it (sheet name)
2) what to put in the new sheet
3) does sheet3 have an actual name

 

[montecarlo2012]

Thanks Alex.
I will repeat your question in order to explained better, Thanks.

You need to provide an XL2BB of what I assume is sheet3 ---

Sorry, I hope it is possible to work with this image, because I have problems trying to install XL2BB.
The only different between this super-small example and the real data is the size
The real data on sheet 3 is a dynamic array (“B2:G3000”) at the moment.

and explain:
how

1) it's determining
A] when to create a new sheet

Once the code search for the number in the condition
If cell = 1 then
I suppose the code got the info is requested about the value 1
and then before end will create the new sheet, in this case sheet 4
where the results for the intervals values of 1 will be displayed.
then,
will return (loop) and change the condition
for the next number, in this moment will be (2)
if cell = 2 then
the code go to the last line and create the new sheet
in this case will be sheet 5
and will run until the cell number is equal to 53


B] and what to call it (sheet name)

If you create something, I don’t know if you have to call it again,
Sorry I am not smart for this things.

2) what to put in the new sheet

The new sheet like I mentioned, will display the intervals values
for each number in the condition
On every sheet designated


3) does sheet3 have an actual name
No name, just the index number

this is the example of sheet 3 [( I know this is a problem, if you decide to abandon this thread, I will perfectly understand. "Sorry")]

for this small example the results on sheet 4 for the value 1 will be

 

[Alex Blakenburg]

I am afraid that I still don’t understand the logic.

• Your code starts in sheet3 column B hits 1 the first time in row 2 - what is supposed to happen ? (Create sheet ? & Output what to what cell)
• Later on in column B it hits one again on rows 12 & 20 what happens then ?
• It then hits 1 again in column C row 20, what does it do then ?
• Your sample output has 8 in C & D where does the 8 come from, none of the cells with a 1 have any association with 8.

I assume we now do the same for 2.

Do we repeat using a “for loop” from 1 to 53 ?

 

[montecarlo2012]

Thank you Alex for your respond.
I am agree about my fuzzy logic, sorry.
I want to make a little recall about how all this started.
This case start with a simple question about how to count in a list of numbers, the intervals or gaps the same value take in the list, and for that there are a excel formula that work, for one line really good.



=SMALL(IF($C$2:$C$15=$E$3, MATCH(ROW($C$2:$C$15), ROW($C$2:$C$15)), ""), ROW(A1)+1)-SMALL(IF($C$2:$C$15=$E$3, MATCH(ROW($C$2:$C$15), ROW($C$2:$C$15)), ""), ROW(A1))

And the tiny-little example is this

So here the question is: without change anything in the question, how to do it with vba

So here it is on vba

Sub Interval()
Set rngData = Range("B2", "B15")
m = -1
For Each cell In rngData
If cell = 1 Then
Range("E2").Offset(0, m) = n
n = 0
m = m + 1
Else
n = n + 1
End If
Next
End Sub

Now is possible to change the parameter of the question about:
How I will do that with a bigger line but still number one, but display the result in different sheet like 3.
and start B2 until B2902 just for exercise on loops.

sub s_val()
Set rngData = Sheet1.Range("B2", "B2902")
m = -1
For Each cell In rngData
If cell = 1 Then
Sheet3.Range("D2").Offset(0, m) = n
n = 0
m = m + 1
Else
n = n + 1
End If
Next
end sub

So now again the question can be change for
What about if instead of a fixed column B2:B2902 I want dynamic
But what if instead of 1 column I need 6 column,
And display the results for each column in another sheet, but still we are talking about
When the condition is equal to 1.

Well this is the code

Sub L_100m()
Dim SrcWS As Worksheet, DestWS As Worksheet
Dim rngData As Range, cell As Range, m, n
Dim rngDest As Range, i As Long

Set SrcWS = Sheet1 ‘location of the array to read
Set DestWS = Sheet2 ‘location of the results to write

Set rngDest = DestWS.Range("C2")
For i = 0 To 5
Set rngData = SrcWS.Range(SrcWS.Cells(2, 2 + i), SrcWS.Cells(SrcWS.Rows.Count, 2 + i).End(xlUp))
m = -1
For Each cell In rngData
If cell = 2 Then
rngDest.Offset(0, m) = n
n = 0
m = m + 1
Else
n = n + 1
End If
Next cell
Set rngDest = rngDest.Offset(16)
Next i
End Sub

So now the question again can be change for
Beside the changes already on place
What about if the value 1 also change
One by one until, let say 53
And each time the value change
The sheet where the results must be also change.
And here I didn’t show all the other statistic items on the original post
I am making plane.
This is more or less the story of my question, sorry is to long but I hope
Is for good.
In this moment I just create all the sheet I need so just make the code
The the if statement value will be good. Thanks.

I believe in something like

Sub L()
Dim SrcWS As Worksheet, DestWS As Worksheet
Dim rngData As Range, cell As Range, m, n
Dim rngDest As Range, i As Long
Dim j%
Set SrcWS = Sheet1 ‘location of the array to read
Set DestWS = Sheet2 ‘location of the results to write
Set rngDest = DestWS.Range("C2")
For j = 1 to 53
For i = 0 To 5
Set rngData = SrcWS.Range(SrcWS.Cells(2, 2 + i), SrcWS.Cells(SrcWS.Rows.Count, 2 + i).End(xlUp))
m = -1
For Each cell In rngData
If cell = j Then
rngDest.Offset(0, m) = n

just wondering.


Thanks for reading this.

 

[Alex Blakenburg]

That was helpful.

See if this gives you what you need:
Note: it will create 53 new sheets
Note2: your dim line below does not allocate a data type to m & n so they will default to variant. I have changed this in my code
Dim rngData As Range, cell As Range, m, n

Sub L_100m_multipleSheets()
    Dim SrcWS As Worksheet, DestWS As Worksheet
    Dim rngData As Range, cell As Range
    Dim rngDest As Range
    Dim i As Long, m As Long, n As Long
    Dim j As Long
    
    Set SrcWS = Sheet3 'location of the array to read
    
    For j = 1 To 53
        Worksheets.Add After:=Worksheets(Worksheets.Count)
        Set DestWS = ActiveSheet
        Set rngDest = DestWS.Range("C2")
        n = 0
        For i = 0 To 5
            Set rngData = SrcWS.Range(SrcWS.Cells(2, 2 + i), SrcWS.Cells(SrcWS.Rows.Count, 2 + i).End(xlUp))
            m = -1
            For Each cell In rngData
                If cell = j Then
                    rngDest.Offset(0, m) = n
                    n = 0
                    m = m + 1
                Else
                    n = n + 1
                End If
            Next cell
            Set rngDest = rngDest.Offset(16)
        Next i
    Next j
End Sub

 

[montecarlo2012]

Alex you make my Sunday. Thank you. work perfect .I check as solution plus a like.
So now the story of this question is growing up,
See you next episode.

 

[Alex Blakenburg]

You are up early. Thanks for your feedback, glad we got there in the end. I appreciated the effort you put in at your end.