/vba/ how to make it the worksheet index becoming a variable for looping [workbook-link]

montecarlo2012

montecarlo2012

Well-known Member
Joined
Jan 26, 2011
Messages
985
Office Version
  1. 2010
Platform
  1. Windows
Hello.
I am trying to putting together some work but the second part is difficult to find on internet what specifically I need.
this is the first part of the code already accomplish with a lot help.
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
this code read an array of six columns and return the gaps between the same value, and every value have their own sheet to be display
now my problem is that the elementary basic code I did for the statistic propose have sheets that must be adjusted to according to what I am doing.
my workbook is in this link
worksheetindex.xlsm
and the code
IF
What I just said is no clear also you can see the development and effort I putting to accomplished this
as a reference how this work start, what I need, what I am looking for and all those question can found answer in this link

www.mrexcel.com

vba.- Adding Sheets.

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...
www.mrexcel.com www.mrexcel.com

so what I need to add is this code:
VBA Code: 
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
    
    Dim Cl As Long
 For Cl = 2 To Cells(2, Columns.Count).End(xlToLeft).Column
 Cells(1, Cl) = Abs(Cells(2, Cl) - Cells(2, Cl + 1))
 Cells(17, Cl) = Abs(Cells(18, Cl) - Cells(18, Cl + 1))
 Cells(33, Cl) = Abs(Cells(34, Cl) - Cells(35, Cl + 1))
 
 Cells(50, Cl) = Abs(Cells(51, Cl) - Cells(35, Cl + 1))
 Cells(66, Cl) = Abs(Cells(67, Cl) - Cells(35, Cl + 1))
 Cells(82, Cl) = Abs(Cells(83, Cl) - Cells(35, Cl + 1))
 
Next
    ':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
'::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
'::::::::::::::::::::::::::::::::::::::::::B2::::::::::::::::::::::::::::::::::::::::::::::::::::::
Range("B8").Formula = "=COUNTIF(B2:XX2,B7)" 'QTY MODE
Range("B9").Formula = "=COUNTIF(B2:XX2,B2)"   'QTY LAST
Range("B11").Formula = "=average(B1:XX1)" ' average distribution B1
':::::::::::::::::::::::::::::::::::::::::: C 18:::::::::::::::::::::::::::::::::::::::::::::::::::::::
Range("B24").Formula = "=COUNTIF(B18:XX18,B17)" 'QTY MODE
Range("B25").Formula = "=COUNTIF(B18:XX18,B18)"   'QTY LAST
Range("B27").Formula = "=average(B17:XX17)" ' average distribution B17

':::::::::::::::::::::::::::::::::::::::::::D34::::::::::::::::::::::::::::::::::::::::::::::::::::::
Range("B40").Formula = "=COUNTIF(B34:XX34,B33)" 'QTY MODE
Range("B41").Formula = "=COUNTIF(B34:XX34,B34)"   'QTY LAST
Range("B43").Formula = "=COUNTIF(B33:XX34,B33)"   'average distribution B33
'.::::::::::::::::::::::::::::::::::::::::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("Sheet8")                                                    ' 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"")"
Sheet4.Range("Y4").Value = Sheet8.Range("B45").Value 'B

Range("B31").Formula = "=IF(B48>=B23,""NO"",""YES"")"
Sheet4.Range("Z4").Value = Sheet8.Range("B34").Value 'C

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

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

Range("B79").Formula = "=IF(B66>=B74,""NO"",""YES"")"
Sheet4.Range("AC4").Value = Sheet8.Range("B79").Value 'AC=F/4

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

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

Range("B30").Formula = "=if(B25=4,""yes"",""no"")"   'this ranges are fix.
Sheet4.Range("K4").Value = Sheet8.Range("B30").Value

Range("B46").Formula = "=if(B44=4,""yes"",""no"")"
Sheet4.Range("L4").Value = Sheet8.Range("B46").Value

Range("B62").Formula = "=if(B57=4,""yes"",""no"")"
Sheet4.Range("M4").Value = Sheet8.Range("B62").Value

Range("B78").Formula = "=if(B73=4,""yes"",""no"")"
Sheet4.Range("N4").Value = Sheet8.Range("B78").Value

Range("B94").Formula = "=if(B89=4,""yes"",""no"")"
Sheet4.Range("O4").Value = Sheet8.Range("B94").Value

End Sub

[ATTACH type="full" width="515px"]41198[/ATTACH]
I would like to be able to change the index value of the worksheet in order to display the results on the right location
Please,
if you read this post, leave at least a note, last time my post got 300 views and only one person was able to solve
I hope to have better luck this time

thank you for reading this.
 

Attachments

  • 1624206431611.png
    1624206431611.png
    48.8 KB · Views: 23

Excel Facts

Shade all formula cells
To shade all formula cells: Home, Find & Select, Formulas to select all formulas. Then apply a light fill color.
Sort by date Sort by votes
See if the below code works for you. It contains 2 subs covering the 2 lots of code you had in your question and you will need to copy both into your module (take a backup first).

I have had to make some assumptions which include:-
  • Created sheets will be named with a prefix driven by this line:-
    DestWSPrefix = "Output" 'Identify output sheets
  • Any sheet starting with the above prefix will be deleted prior to running the rest of the code.
    You will get 1 chance to quite the macro at the point
  • I believe sheet4 is an old reference and that it is now sheet3, so I have used the SrcWS (sheet3) in the 2nd Sub for the summary output.
    All static sheets should be given a meaningful name and we can change what sheet is meant to be the summary sheet if we need to (in your original code referenced as Sheet4)
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
    Dim DestWSPrefix As String
    Dim DestWSPrefixLen As Long
    Dim strMsg As String
    Dim MsgResponse As VbMsgBoxResult
    Dim ws As Worksheet
    
    
    DestWSPrefix = "Output"                                     'Identify output sheets
    DestWSPrefixLen = Len(DestWSPrefix)
    
    strMsg = "Running this macro will DELETE all existing " & vbCr
    strMsg = strMsg & "sheets starting with the prefix --> " & DestWSPrefix & vbCr & vbCr
    strMsg = strMsg & "Do you wish to continue ? "
    
    MsgResponse = MsgBox(Prompt:=strMsg, Buttons:=vbYesNo, Title:="Run Macro and Delete Previous Results")
    
    If MsgResponse = vbNo Then
        MsgBox "Macro terminated at users request"
        Exit Sub
    End If
    
    ' Delete previous output sheets
    Application.DisplayAlerts = False
    For Each ws In ActiveWorkbook.Worksheets
        If Left(ws.Name, DestWSPrefixLen) = DestWSPrefix Then
            ws.Delete
        End If
    Next ws
    Application.DisplayAlerts = True
    
    
    Set SrcWS = Worksheets("Sheet3")                                        'location of the array to read
    
    For j = 1 To 3
        Worksheets.Add After:=Worksheets(Worksheets.Count)
        Set DestWS = ActiveSheet                                'location of the results to write
        DestWS.Name = DestWSPrefix & " " & Format(j, "00")      'Rename new Sheet based on j
        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
        
        Call AddCalcsSummaryFormat(SrcWS)
    Next j
End Sub


Sub AddCalcsSummaryFormat(SrcWS As Worksheet)

    ' Assumptions:
    ' 1) that the Summary Output Sheet is the same as the Data Sheet
    ' 2) that the sub is run on the ActiveSheet being the newly added sheet
    
    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
        
    Dim Cl As Long
    
    For Cl = 2 To Cells(2, Columns.Count).End(xlToLeft).Column
        Cells(1, Cl) = Abs(Cells(2, Cl) - Cells(2, Cl + 1))
        Cells(17, Cl) = Abs(Cells(18, Cl) - Cells(18, Cl + 1))
        Cells(33, Cl) = Abs(Cells(34, Cl) - Cells(35, Cl + 1))
         
        Cells(50, Cl) = Abs(Cells(51, Cl) - Cells(35, Cl + 1))
        Cells(66, Cl) = Abs(Cells(67, Cl) - Cells(35, Cl + 1))
        Cells(82, Cl) = Abs(Cells(83, Cl) - Cells(35, Cl + 1))
     
    Next
        ':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
    '::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
    '::::::::::::::::::::::::::::::::::::::::::B2::::::::::::::::::::::::::::::::::::::::::::::::::::::
    Range("B8").Formula = "=COUNTIF(B2:XX2,B7)" 'QTY MODE
    Range("B9").Formula = "=COUNTIF(B2:XX2,B2)"   'QTY LAST
    Range("B11").Formula = "=average(B1:XX1)" ' average distribution B1
    ':::::::::::::::::::::::::::::::::::::::::: C 18:::::::::::::::::::::::::::::::::::::::::::::::::::::::
    Range("B24").Formula = "=COUNTIF(B18:XX18,B17)" 'QTY MODE
    Range("B25").Formula = "=COUNTIF(B18:XX18,B18)"   'QTY LAST
    Range("B27").Formula = "=average(B17:XX17)" ' average distribution B17
    
    ':::::::::::::::::::::::::::::::::::::::::::D34::::::::::::::::::::::::::::::::::::::::::::::::::::::
    Range("B40").Formula = "=COUNTIF(B34:XX34,B33)" 'QTY MODE
    Range("B41").Formula = "=COUNTIF(B34:XX34,B34)"   'QTY LAST
    Range("B43").Formula = "=COUNTIF(B33:XX34,B33)"   'average distribution B33
    '.::::::::::::::::::::::::::::::::::::::::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 ColorRng As Range
    Dim ColorCell As Range

    Set ColorRng = 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 ColorCell
    
    Range("B15").Formula = "=IF(B2>=B7,""NO"",""YES"")"
    SrcWS.Range("Y4").Value = Range("B45").Value 'B
    
    Range("B31").Formula = "=IF(B48>=B23,""NO"",""YES"")"
    SrcWS.Range("Z4").Value = Range("B34").Value 'C
    
    Range("B47").Formula = "=IF(B34>=B39,""NO"",""YES"")"
    SrcWS.Range("AA4").Value = Range("B47").Value 'D
    
    Range("B63").Formula = "=IF(B4>=B55,""NO"",""YES"")"
    SrcWS.Range("AB4").Value = Range("B63").Value 'E
    
    Range("B79").Formula = "=IF(B66>=B74,""NO"",""YES"")"
    SrcWS.Range("AC4").Value = Range("B79").Value 'AC=F/4
    
    Range("B95").Formula = "=IF(B82>=B87,""NO"",""YES"")"
    SrcWS.Range("AD4").Value = Range("B95").Value 'AD=G/4
    '::::::::::::::::::::::decision table 2 :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
    
    Range("B44").Formula = "=if(B9=4,""yes"",""no"")"
    SrcWS.Range("J4").Value = Range("B44").Value ' this line on sheet (3) increase by one, in the next sheet would be J3 and the same with the other columns.
    
    Range("B30").Formula = "=if(B25=4,""yes"",""no"")"   'this ranges are fix.
    SrcWS.Range("K4").Value = Range("B30").Value
    
    Range("B46").Formula = "=if(B44=4,""yes"",""no"")"
    SrcWS.Range("L4").Value = Range("B46").Value
    
    Range("B62").Formula = "=if(B57=4,""yes"",""no"")"
    SrcWS.Range("M4").Value = Range("B62").Value
    
    Range("B78").Formula = "=if(B73=4,""yes"",""no"")"
    SrcWS.Range("N4").Value = Range("B78").Value
    
    Range("B94").Formula = "=if(B89=4,""yes"",""no"")"
    SrcWS.Range("O4").Value = Range("B94").Value

End Sub
 
Upvote 0
Solution
Mr. Alex and the rest of the dirty code like:
VBA Code: 
Range("B8").Formula = "=COUNTIF(B2:XX2,B7)" 'QTY MODE
Range("B9").Formula = "=COUNTIF(B2:XX2,B2)" 'QTY LAST
Range("B24").Formula = "=COUNTIF(B18:XX18,B17)" 'QTY MODE
Range("B25").Formula = "=COUNTIF(B18:XX18,B18)" 'QTY LAST
Range("B40").Formula = "=COUNTIF(B34:XX34,B33)" 'QTY MODE
Range("B41").Formula = "=COUNTIF(B34:XX34,B34)" 'QTY LAST
Range("B56").Formula = "=COUNTIF(B50:XX50,B49)" 'QTY MODE
Range("B57").Formula = "=COUNTIF(B50:XX50,B50)" 'QTY LAST
Range("B72").Formula = "=COUNTIF(B66:XX66,B65)" 'QTY MODE
Range("B73").Formula = "=COUNTIF(B66:XX66,B66)" 'QTY LAST
Range("B88").Formula = "=COUNTIF(B82:XX82,B81)" 'QTY MODE
Range("B89").Formula = "=COUNTIF(B82:XX82,B82)" 'QTY LAST

I used the for next like:
VBA Code: 
Dim k&, nn&, ii&
k = 2
nn = 7
For ii = 8 To 88 Step 16
Cells(ii, 2).Formula = "=COUNTIF(" & Cells(k, 2).Address & " : " & Cells(k, 700).Address & "," & Cells(nn, 2).Address & ")"
k = k + 16
nn = nn + 16
Next
so now everything is fine, good lessons I got here, and thank you Alex for all your Advice
 
Upvote 0
Happy to help. Thanks for the feedback and glad you are making progress on your project.
 
Upvote 0
You must log in or register to reply here.

Similar threads

C
  • Solved
index match excel formula to vba code
Replies
9
Views
330
DanteAmor
DanteAmor
montecarlo2012
  • Question Question
vba Adding worksheets with the same format (workbook - link - upload)
2
Replies
10
Views
1K
montecarlo2012
montecarlo2012
S
  • Question Question
Create New Sheet with Specific Name Based on Variable Cell
Replies
0
Views
181
SBExcel123
S
montecarlo2012
  • Solved
vba.- Adding Sheets.
2 3
Replies
24
Views
2K
montecarlo2012
montecarlo2012
M
  • Question Question
Displaying number based on date conditions column and True/False column.
Replies
2
Views
258
mike4777
M

Forum statistics

Threads
1,223,711
Messages
6,174,025
Members
452,542
Latest member
Bricklin

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