Create Sub array variable name sheet

Question

I have one array with Sheet Names called SheetNames and I want to generate a sub array of it that only returns True at the condition (IF). I try to have a loop into a cell value onto different sheets, evaluating condition cell.value = "S". When checks that for the first D column (z = 4) I want to make the same check (IF condition) for columns D to DR at the same row.

I need to get similar result if I use formula at

Diary!C7   
= IF (element!D6 = "S",CONCATENATE (element!B1, ", "), ""), 
  IF (element1!D6 = "S",CONCATENATE (element1!B1, ", "), ""), .... 
  IF (element!E6 = "S",CONCATENATE (element!B1, ", "), ""), 
  IF (element1!E6 = "S",CONCATENATE (element1!B1, ", "), "") .... )

Where element is a sheet name taken from an array with the sheet names who get the condition (Code S or another code).

SheetNames is one array with all the book sheets and FSheet (Filtered Sheet with condition) an array with only the filtered (with condition IF). When I can populate FSheet array for each sheet I test the condition then I must concatenate it's values at another sheet/cell and began the test condition again to the next cell (E6) ... But I'm trapped at the step to create FSheet.

        Sub Test()
        Dim ws As Worksheet
        Dim SheetNames() As String, FSheets() As String, q As String
        Dim element As Variant
        Dim lastSheet As Integer, r As Integer, incrSheet As Integer, i As Integer
        Dim Rgn As Range
     ' Enter the sheet names into an array. Redim array's size to the number of sheets (lastSheet)
      For Each ws In ActiveWorkbook.Worksheets
        ReDim Preserve SheetNames(lastSheet)
        SheetNames(lastSheet) = ws.name
        lastSheet = lastSheet + 1
       Next ws
    MsgBox lastSheet
    ' Test condition for each sheet/cell
    For z = 4 To 11
        For Each element In SheetNames()
            incrSheet = 1
            If ActiveWorkbook.Sheets(element).Cells(6, z).Value = "S" Then
                 ReDim Preserve FSheets(incrSheet)
                 FSheets(incrSheet) = element
                 incrSheet = incrSheet + 1
            End If
        Next element
    Next z
    i = 3
' Define the sheet to work (total project will have more than one, one for code we need test, S, C, etc) 
With Worksheets("Diary")
        .Activate
        .Range("C7").Select
 ' Concatenate values at Summary page   
    Do
        Cells(7, i).Select
            For r = 1 To UBound(FSheets)
            'Concatenate with &:
               varConctnt = varConctnt & ", " & FSheets(r)
               Next r
            'remove the "&" before the first element:
            varConctnt = Mid(varConctnt, 2)
            q = varConctnt
            varConctnt = ""
        i = i + 1
        ActiveCell.Value = q
    Loop While i < 11
' Drag the formula for the rest of the rows
Range("C7:J7").Select
        Selection.AutoFill Destination:=Range("C7:J12"), Type:=xlFillDefault
    End With
    End Sub

you have a few syntax errors, For z = 4 To z = 11 need to be For z = 4 To 11 . What range are you trying to use here : Range("& z&6") ? can you explain ? — Shai Rado
I edit the post, hope clarify it. With Range("& z&6") I want to create a dynamic range with for example, D6, E6 .... to DR6. I make like that because I want to Check the condition at D6 for all sheet Name and then write the concatenate value at one cell, check condition at E6 for all the sheet names and write the value onto another cell of a summary sheet. To simplify I put only the part of code is malfunction — Judith

Jonathan Willcock Jonathan Willcock · Accepted Answer · 2017-09-14T06:28:53

Where you are going wrong, is your attempt to dynamically set the range. Assuming you are testing the value of a single cell, it is much easier to use Cells, rather than Range, since you can use R1C1 notation. Try something like this:

incrSheet = 1 
For z = 4 To 11
    For Each element In SheetNames()
        If ActiveWorkbook.Sheets(element).Cells(6, z).Value = "S" Then
             ReDim Preserve FSheets(incrSheet)
             FSheets(incrSheet) = element
             MsgBox incrSheet
             incrSheet = incrSheet + 1
        End If
    Next element
Next z

Create Sub array variable name sheet

1 Answers