vba.- Adding Sheets.

montecarlo2012 · May 31, 2021

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:

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.

Alex Blakenburg · Jun 1, 2021

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

montecarlo2012 · Jun 17, 2021

Thank you Alex for your intervention, I didn't see this before.
I am still wondering my problem.

Alex Blakenburg · Jun 17, 2021

No problem, where did you get to, what do you still need ?

montecarlo2012 · Jun 17, 2021

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.

Alex Blakenburg · Jun 17, 2021

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 ?

Alex Blakenburg · Jun 17, 2021

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

montecarlo2012 · Jun 17, 2021

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.

my goal is that when the line

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.

Alex Blakenburg · Jun 18, 2021

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

montecarlo2012 · Jun 18, 2021

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

right here:

I hope the best weekend for you.

vba.- Adding Sheets.

montecarlo2012

Well-known Member

Excel Facts

Alex Blakenburg

MrExcel MVP

montecarlo2012

Well-known Member

Alex Blakenburg

MrExcel MVP

montecarlo2012

Well-known Member

Alex Blakenburg

MrExcel MVP

Alex Blakenburg

MrExcel MVP

montecarlo2012

Well-known Member

Alex Blakenburg

MrExcel MVP

montecarlo2012

Well-known Member

Similar threads

Forum statistics

Share this page

vba.- Adding Sheets.

Well-known Member

Excel Facts

MrExcel MVP

Well-known Member

MrExcel MVP

Well-known Member

MrExcel MVP

MrExcel MVP

Well-known Member

MrExcel MVP

Well-known Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock