vba.- Adding Sheets.

montecarlo2012

Well-known Member
Joined
Jan 26, 2011
Messages
984
Office Version
  1. 2010
Platform
  1. Windows
Hello all.
VBA Code:
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:
1622481516761.png

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.
 
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
 
Upvote 0

Excel Facts

How to fill five years of quarters?
Type 1Q-2023 in a cell. Grab the fill handle and drag down or right. After 4Q-2023, Excel will jump to 1Q-2024. Dash can be any character.
now the code is like
VBA Code:
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))
 
Upvote 0
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,
 
Upvote 0
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
 
Upvote 0
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")]

1624067014631.png

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

1624067219607.png
 
Upvote 0
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 ?
 
Upvote 0
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

1624140429253.png


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

So here it is on vba

VBA Code:
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.
VBA Code:
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
VBA 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

VBA Code:
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.
VBA Code:
 
Upvote 0
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


VBA Code:
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
 
Upvote 0
Solution
:love:(y) 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. :ROFLMAO:
 
Upvote 0
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.
 
Upvote 0

Forum statistics

Threads
1,213,486
Messages
6,113,932
Members
448,533
Latest member
thietbibeboiwasaco

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top