vba.- Adding Sheets.

montecarlo2012

montecarlo2012

Well-known Member
Joined
Jan 26, 2011
Messages
986
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.
 

Excel Facts

Why does 9 mean SUM in SUBTOTAL?
It is because Sum is the 9th alphabetically in Average, Count, CountA, Max, Min, Product, StDev.S, StDev.P, Sum, VAR.S, VAR.P.
Sort by date Sort by votes
Is your only issue with doing the loop related to the fact that you are using codenames for the sheets and you don't know how to increment them ? (CodeNames don't let you say "Sheet" & 2 while you can do that for the displayed sheet name)
Also are you looping through most of the sheets each time, in which case you could loop through all sheets and just "exclude" the ones you don't want to work on.

The below is based on the premise that the Sheet Codename = "Sheet" & value in Cell + 1 eg cell = 2 is Sheet 2 +1 = Sheet3

VBA Code: 
Sub CodeNameUsingDict()

    Dim DestWS As Worksheet
    Dim cell As Range
    
    ' ---- Dictionary Set Up ----
    ' Specific to changes using dictionay
    Dim dictSheet As Object
    Dim ws As Worksheet
    Dim shtName As String
   
   ' Load mapping data into the dictionary
    Set dictSheet = CreateObject("scripting.dictionary")
   
    For Each ws In Worksheets
       dictSheet.Item(ws.CodeName) = ws.Name
    Next ws
    
    ' ---- Usage in Looping ----
    ' Selecting sheet based on cell value in Loops
    Set cell = ActiveCell       ' For testing only
    shtName = dictSheet.Item("Sheet" & (cell + 1))
    Set DestWS = Worksheets(shtName)

End Sub
 
Upvote 0
Thank you Alex for your intervention, I didn't see this before.
I am still wondering my problem.
 
Upvote 0
Thank you Alex.
In my workbook the first sheet is a consolidate report, and on sheet (3) I have the source data, is a dynamic array on B2:G
the code I have I really don't want to copy and paste 53 time plus change every sheet value every time.
this is the code with the notes where I would like to have a loop instead of, manually iteration.
thanks.
VBA Code: 
Option Explicit

Sub interval_report()

'I would like to avoid copy and paste this code 53 times

    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 = Sheet3 '::::::::::::::::::::::::::::::::::::::::::::::DATA SOURCE
    
    Set DestWS = Sheet4 '::::::::::::::::::::::::::::::::::::::::::::DATA DESTINATION
    
    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 = 1 Then  '::::::::this is the number to change on every sheet.::Start on number 1 to 53

                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
Dim ws As Worksheet
Dim ColorRng As Range
Dim ColorCell As Range
Set ws = Worksheets("Sheet4")                                                    ' this number also need to be in a loop
Set ColorRng = ws.Range("B5,B21,B37,B53,B69,B85")
For Each ColorCell In ColorRng
If ColorCell.Value = Application.WorksheetFunction.Max(ColorRng) Then
ColorCell.Interior.Color = RGB(255, 153, 0)
End If
Next
Range("B15").Formula = "=IF(B2>=B7,""NO"",""YES"")"
Sheet1.Range("Y4").Value = Sheet4.Range("B15").Value 'B

Range("B31").Formula = "=IF(B18>=B23,""NO"",""YES"")"
Sheet1.Range("Z2").Value = Sheet4.Range("B31").Value 'C

Range("B47").Formula = "=IF(B34>=B39,""NO"",""YES"")"
Sheet1.Range("AA2").Value = Sheet4.Range("B47").Value 'D

Range("B63").Formula = "=IF(B4>=B55,""NO"",""YES"")"
Sheet1.Range("AB2").Value = Sheet4.Range("B63").Value 'E

Range("B79").Formula = "=IF(B66>=B71,""NO"",""YES"")"
Sheet1.Range("AC2").Value = Sheet4.Range("B79").Value 'AC=F/4

Range("B95").Formula = "=IF(B82>=B87,""NO"",""YES"")"
Sheet1.Range("AD2").Value = Sheet4.Range("B95").Value 'AD=G/4
'::::::::::::::::::::::decision table 2 :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

Range("B14").Formula = "=if(B9=1,""yes"",""no"")"
Sheet1.Range("J2").Value = Sheet4.Range("B14").Value ' this line on sheet (1) increase by one, in the next sheet would be J3 and the same with the other columns.

Range("B30").Formula = "=if(B25=1,""yes"",""no"")"   'this ranges are fix.
Sheet1.Range("k2").Value = Sheet4.Range("B30").Value

Range("B46").Formula = "=if(B41=1,""yes"",""no"")"
Sheet1.Range("L2").Value = Sheet4.Range("B46").Value

Range("B62").Formula = "=if(B57=1,""yes"",""no"")"
Sheet1.Range("M2").Value = Sheet4.Range("B62").Value

Range("B78").Formula = "=if(B73=1,""yes"",""no"")"
Sheet1.Range("N2").Value = Sheet4.Range("B78").Value

Range("B94").Formula = "=if(B89=1,""yes"",""no"")"
Sheet1.Range("O2").Value = Sheet4.Range("B94").Value
End Sub
Loops are hard for me to handle.
Thank you Alex.
 
Upvote 0
Does your code already do what you want using SrcWS and it is just a question of looping through all the worksheets ?
Is Sheet4 the only one that you don't want to use as one of the SrcWS sheets, in which case we can loop through all sheets and just exclude the sheet with a CodeName of Sheet4 (or the actual sheet name you want to use that and tell me what it is) ?
The first time you use N you have not set it to anything yet and then you set it to 0.
What sheet are you assuming is the active sheet when you get past Set Rg = Nothing ?
 
Upvote 0
See if the below works for you.
The "For Each" statement is the equivalent of your
Set SrcWS = Sheet3 '::::::::::::::::::::::::::::::::::::::::::::::DATA SOURCE
but instead of Sheet3 it replaces it with the next sheet on every iteration.
Where I have my Debug.Print statement you put all the code that you want to work on every SrcWS sheet.
If you want to exclude more than just Sheet4 then you need to modify the If statement to exclude what needs to be excluded.

VBA Code: 
Sub LoopThroughSheets()

    Dim SrcWS As Worksheet
    
    For Each SrcWS In ActiveWorkbook.Worksheets
    
        If SrcWS.CodeName <> "Sheet4" Then
            
            ' Put code for updating each workbook here
            Debug.Print SrcWS.Name, SrcWS.CodeName
        
        End If
    
    Next SrcWS

End Sub
 
Upvote 0
Thanks Alex for your quick respond.
Ok about your questions.

1 - Looping through all the worksheets?

No, it is not about that, because I am looking to
Create
A new worksheet every time run.

2 – avoid sheet 4
No, the sheet 4 is the first one to use when the condition

If cell = 1

Then when the sub end create sheet 5
And the condition must be

If cell = 2

And so on

3 – about N not set to anything, and also about Set Rg = nothing
This code is from post # 1170245

and On sheet 3 I have the source data

I inserted your lines in the code like you said, but I got error, here you are.

1623980461640.png



my goal is that when the line

1623980650821.png

when the condition is equal to 1 the output will be display on sheet 4
and for 2 in 5 and so on until the condition = 53

thank you.
 
Upvote 0
Sorry in terms of what you tried, I seem to have gotten your variables the wrong way around.

VBA Code: 
Sub LoopThroughSheets()

    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 '::::::::::::::::::::::::::::::::::::::::::::::DATA SOURCE
    
    ' Set DestWS = Sheet4 '::::::::::::::::::::::::::::::::::::::::::::DATA DESTINATION - Replaced by loop
    
    Set rngDest = DestWS.Range("C2")
    
    For Each DestWS In ActiveWorkbook.Worksheets
    
        If DestWS.CodeName <> "Sheet3" Then
            
            ' Put code for updating each workbook here
            Debug.Print DestWS.Name, DestWS.CodeName
        
        End If
    
    Next DestWS

End Sub
 
Upvote 0
Thank you Alex, now the complete code looks:
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
Set rngDest = DestWS.Range("C2")

            For Each DestWS In ActiveWorkbook.Worksheets
                  If DestWS.CodeName <> "Sheet3" Then
                              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 = 1 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
                  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
                  Dim ws As Worksheet
                  Dim ColorRng As Range
                  Dim ColorCell As Range
                  Set ws = Worksheets("Sheet4")                                                    ' this number also need to be in a loop
                  Set ColorRng = ws.Range("B5,B21,B37,B53,B69,B85")
                  For Each ColorCell In ColorRng
                  If ColorCell.Value = Application.WorksheetFunction.Max(ColorRng) Then
                  ColorCell.Interior.Color = RGB(255, 153, 0)
                  End If
                  Next
                  Range("B15").Formula = "=IF(B2>=B7,""NO"",""YES"")"
                  Sheet1.Range("Y2").Value = Sheet4.Range("B15").Value 'B
                  
                  Range("B31").Formula = "=IF(B18>=B23,""NO"",""YES"")"
                  Sheet1.Range("Z2").Value = Sheet4.Range("B31").Value 'C
                  
                  Range("B47").Formula = "=IF(B34>=B39,""NO"",""YES"")"
                  Sheet1.Range("AA2").Value = Sheet4.Range("B47").Value 'D
                  
                  Range("B63").Formula = "=IF(B4>=B55,""NO"",""YES"")"
                  Sheet1.Range("AB2").Value = Sheet4.Range("B63").Value 'E
                  
                  Range("B79").Formula = "=IF(B66>=B71,""NO"",""YES"")"
                  Sheet1.Range("AC2").Value = Sheet4.Range("B79").Value 'AC=F/4
                  
                  Range("B95").Formula = "=IF(B82>=B87,""NO"",""YES"")"
                  Sheet1.Range("AD2").Value = Sheet4.Range("B95").Value 'AD=G/4
                  '::::::::::::::::::::::decision table 2 :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
                  
                  Range("B14").Formula = "=if(B9=1,""yes"",""no"")"
                  Sheet1.Range("J2").Value = Sheet4.Range("B14").Value
                  
                  Range("B30").Formula = "=if(B25=1,""yes"",""no"")"
                  Sheet1.Range("k2").Value = Sheet4.Range("B30").Value
                  
                  Range("B46").Formula = "=if(B41=1,""yes"",""no"")"
                  Sheet1.Range("L2").Value = Sheet4.Range("B46").Value
                  
                  Range("B62").Formula = "=if(B57=1,""yes"",""no"")"
                  Sheet1.Range("M2").Value = Sheet4.Range("B62").Value
                  
                  Range("B78").Formula = "=if(B73=1,""yes"",""no"")"
                  Sheet1.Range("N2").Value = Sheet4.Range("B78").Value
                  
                  Range("B94").Formula = "=if(B89=1,""yes"",""no"")"
                  Sheet1.Range("O2").Value = Sheet4.Range("B94").Value
                  End If
            Next DestWS
End Sub
after run the code I got this
1624047918633.png

right here:
1624047946047.png

I hope the best weekend for you.
 
Upvote 0
You must log in or register to reply here.

Similar threads

montecarlo2012
  • Question Question
vba Adding worksheets with the same format (workbook - link - upload)
2
Replies
10
Views
1K
montecarlo2012
montecarlo2012
montecarlo2012
  • Solved
/vba/ how to make it the worksheet index becoming a variable for looping [workbook-link]
Replies
4
Views
1K
Alex Blakenburg
A
E
  • Solved
Can someone tell me why the first column is not displaying all info?
Replies
3
Views
161
RoryA
RoryA
montecarlo2012
  • Solved
vba- downsize my code
Replies
6
Views
593
montecarlo2012
montecarlo2012
montecarlo2012
  • Solved
vba how to apply for.....next
Replies
6
Views
545
montecarlo2012
montecarlo2012

Forum statistics

Threads
1,224,747
Messages
6,180,714
Members
452,995
Latest member
isldboy

Share this page

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