VBA For Each, Then

[Kristenisasuperstar]

I am trying to get my code to look at each workbook and if there is a value in the set range to copy data in various cells depending on where the value of data is. I need the Data to go to a summary sheet (already created), but I am getting stuck on how to tell VBA to look at column C in the row the data is found and look in Row 8 of the column the data if found. I hope that is not too confusing.
This is what I have:


Dim cell As Range
Set Rng = Range("D9:BC83")


For Each cell In sht.Name.Rng

If cell.Value <> "" Then myArray(x + 1)=

Next cell

 

[JLGWhiz]

sht.Cells(cell.Row, "C")

will represent column C on the current row the code is addressing.

sht.Cells(8, cell.Column)

will represent row 8 on the current column the code is addressing.

 

[Kristenisasuperstar]

I attached the entire code project I am working on, I am certain I am doing the section of the code (with the super large bolded comment) I am getting a for without a next compile error, and I know that I did not complete the for next loop because I am lost.

Sub Statistics_Create()


Dim sht As Worksheet
Dim Content_sht As Worksheet
Dim myArray As Variant
Dim x As Long, y As Long
Dim shtName1 As String, shtName2 As String
Dim ContentName As String


'Inputs
  ContentName = "Statistics"


'Optimize Code
  Application.DisplayAlerts = False
  Application.ScreenUpdating = False


'Delete Contents Sheet if it already exists
  On Error Resume Next
    Worksheets("Statistics").Activate
  On Error GoTo 0


  If ActiveSheet.Name = ContentName Then
    myAnswer = MsgBox("A worksheet named [" & ContentName & _
      "] has already been created, would you like to replace it?", vbYesNo)
    
    'Did user select No or Cancel?
      If myAnswer <> vbYes Then GoTo ExitSub
      
    'Delete old Contents Tab
      Worksheets(ContentName).Delete
  End If


'Create New Contents Sheet
  Worksheets.Add Before:=Worksheets(1)


'Set variable to Contents Sheet
  Set Content_sht = ActiveSheet


'Format Contents Sheet
  With Content_sht
    .Name = ContentName
        Columns("A:A").Select
    Selection.NumberFormat = "000-00-0000"
    Columns("B:B").Select
    Selection.NumberFormat = "m/d/yy;@"
    Columns("C:C").Select
    Selection.NumberFormat = "_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(@_)"
    Columns("D:D").Select
    Selection.NumberFormat = "General"
    Columns("E:E").Select
    Selection.NumberFormat = "0.00"
    Columns("F:F").Select
    Selection.NumberFormat = "General"
    Columns("G:G").Select
    Selection.NumberFormat = "General"


     Range("A1").Select
    ActiveCell.FormulaR1C1 = "SID"
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "DATE"
    Range("C1").Select
    ActiveCell.FormulaR1C1 = "TIME"
    Range("D1").Select
    ActiveCell.FormulaR1C1 = "SUBJECT"
    Range("E1").Select
    ActiveCell.FormulaR1C1 = "# OF VISITS"
    Range("F1").Select
    ActiveCell.FormulaR1C1 = "CAMPUS"
    Range("G1").Select
    ActiveCell.FormulaR1C1 = "PROGRAM"
    Range("A1:G1").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 15773696
    End With
    Selection.Font.Bold = True
    With Selection.Font
        .Name = "Arial"
        .Size = 14
        .ColorIndex = xlAutomatic
  
    End With
    Columns("A:G").Select
    Selection.ColumnWidth = 16
    Range("A1:G1").Select
  
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With
  
    


'Create Array list with SID Numbers, Dates and Values
  ReDim myArray(1 To Worksheets.Count - 1)
Dim Rng As Range
Dim Cells As Integer
Set Rng = Range("D9:BC83")
If Not Rng Is Nothing Then
  For Each sht In ActiveWorkbook.Worksheets
    If sht.Name <> ContentName Then
  For Each cell In Rng.Cells
  If cell.Value <> "" Then
   myArray(x + 1, 1) = sht.Cells(cell.Row, "C") And myArray(x + 2, 2) = sht.Cells(8, cell.Column) And myArray(x + 2, 3) = sht.Cells(cell.Value) And myArray(x + 2, 4) = sht.Cells("B2") And myArray(x + 2, 6) = sht.Cells("B6") And myArray(x + 2, 7) = sht.Cells("B7")
   
   
      x = x + 1
    
    


  
  End If
  


'Create Statistics
  For x = LBound(myArray) To UBound(myArray)
    Set sht = Worksheets(myArray(x))
    sht.Activate
    
  
With Content_sht
      Range("A1") = Format(SSN, "NNN-NN-NNNN")
       Range("B1") = Format(date_test, "mm/dd/yy")


      
    
    
    ' Column 5: Displays the number of visits using a countif function
    
    .Cells(x + 2, 5).FormulaR1C1 = "=COUNTIF(C[-4],RC[-4])"
   
   '   Find the last filled row in column E


Range("D3:E3").AutoFill Range("D3:E" & Range("E2").End(xlDown).Row)


    End With
  
Content_sht.Activate
Content_sht.Columns(3).EntireColumn.AutoFit


  'Adjust Zoom and Remove Gridlines
    ActiveWindow.DisplayGridlines = True
    ActiveWindow.Zoom = 100


ExitSub:
'Optimize Code
  Application.DisplayAlerts = True
  Application.ScreenUpdating = True
  
End Sub

 

[JLGWhiz]

I cleaned this up as best I could, but I don't understand the line in red font. Also, when using the With statement, the child objects (not variables) must have a period in front of them to tie them to the parent object, otherwise VBA will default to the active sheet.

Sub Statistics_Create()
Dim sht As Worksheet
Dim Content_sht As Worksheet
Dim myArray As Variant
Dim x As Long, y As Long
Dim shtName1 As String, shtName2 As String
Dim ContentName As String
'Inputs
  ContentName = "Statistics"
'Optimize Code
  Application.DisplayAlerts = False
  Application.ScreenUpdating = False
'Delete Contents Sheet if it already exists
  On Error Resume Next
    Worksheets("Statistics").Activate
  On Error GoTo 0
    If ActiveSheet.Name = ContentName Then
          myAnswer = MsgBox("A worksheet named [" & ContentName & _
          "] has already been created, would you like to replace it?", vbYesNo)
        'Did user select No or Cancel?
        If myAnswer <> vbYes Then GoTo ExitSub
            'Delete old Contents Tab
            Worksheets(ContentName).Delete
    End If
        'Create New Contents Sheet
        Worksheets.Add Before:=Worksheets(1)
        'Set variable to Contents Sheet
        Set Content_sht = ActiveSheet
        'Format Contents Sheet
        With Content_sht
            .Name = ContentName
            .Columns("A:A").NumberFormat = "000-00-0000"
            .Columns("B:B").NumberFormat = "m/d/yy;@"
            .Columns("C:C").NumberFormat = "_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(@_)"
            .Columns("D:D").NumberFormat = "General"
            .Columns("E:E").NumberFormat = "0.00"
            .Columns("F:F").NumberFormat = "General"
            .Columns("G:G").NumberFormat = "General"
            .Range("A1") = "SID"
            .Range("B1") = "DATE"
            .Range("C1") = "TIME"
            .Range("D1") = "SUBJECT"
            .Range("E1") = "# OF VISITS"
            .Range("F1") = "CAMPUS"
            .Range("G1") = "PROGRAM"
            With .Range("A1:G1").Interior
                .Pattern = xlSolid
                .PatternColorIndex = xlAutomatic
                .Color = 15773696
            End With
            With .Range("A1:G1").Font
                 .Bold = True
                 .Name = "Arial"
                 .Size = 14
                 .ColorIndex = xlAutomatic
            End With
            .Columns("A:G").ColumnWidth = 16
            With .Range("A1:G1").Borders(xlEdgeBottom)
                .LineStyle = xlContinuous
                .Weight = xlThin
            End With
        End With
'Create Array list with SID Numbers, Dates and Values
 ReDim myArray(1 To Worksheets.Count - 1)
 Dim Rng As Range
 Dim Cells As Integer
 Set Rng = Range("D9:BC83")
     If Not Rng Is Nothing Then
         For Each sht In ActiveWorkbook.Worksheets
             If sht.Name <> ContentName Then
                 For Each cell In Rng.Cells
                     If cell.Value <> "" Then
                       [COLOR=#FF0000] myArray(x + 1, 1) = sht.Cells(cell.Row, "C") And myArray(x + 2, 2) = sht.Cells(8, cell.Column) And myArray(x + 2, 3) = sht.Cells(cell.Value) And myArray(x + 2, 4) = sht.Cells("B2") And myArray(x + 2, 6) = sht.Cells("B6") And myArray(x + 2, 7) = sht.Cells("B7")[/COLOR]
                        x = x + 1
                     End If
                     'Create Statistics
                     For x = LBound(myArray) To UBound(myArray)
                          Set sht = Worksheets(myArray(x))
                          sht.Activate
                          With Content_sht
                              .Range("A1") = Format(SSN, "NNN-NN-NNNN")
                              .Range("B1") = Format(date_test, "mm/dd/yy")
                              ' Column 5: Displays the number of visits using a countif function
                              .Cells(x + 2, 5).FormulaR1C1 = "=COUNTIF(C[-4],RC[-4])"
                              'Find the last filled row in column E
                              .Range("D3:E3").AutoFill Range("D3:E" & Range("E2").End(xlDown).Row)
                          End With
                    Next
                Next
             End If
         Next
    End If
 Content_sht.Columns(3).EntireColumn.AutoFit
  'Adjust Zoom and Remove Gridlines
    ActiveWindow.DisplayGridlines = True
    ActiveWindow.Zoom = 100
ExitSub:
'Optimize Code
  Application.DisplayAlerts = True
  Application.ScreenUpdating = True
End Sub