R
Rick A
Why, in the code below, is the for each loop executing three times? Is there some hidden Excel thing I need to know about.
Private Sub ProcessIndividuals()
Dim myWorkbook As Excel.Workbook
Dim strPath As String
Dim IndividualRange As Range
Dim IndividualCell As Range
Dim strIndividual As String
Dim intPriorityCounter As Integer
Dim PriorityExcel As Excel.Application
Dim PriorityWorksheet As Excel.Worksheet
Dim PriorityRange As Range
Dim PriorityRow As Range
Dim PriorityCell As Range
Const blnDebug As Boolean = True
Const intColumnOne As Integer = 1
Const intAssignToColumn As Integer = 2
Const intPriorityColumn As Integer = 3
Const intJobTicketColumn As Integer = 4
Const intTaskColumn As Integer = 5
Const intEstHrColumn As Integer = 6
Const intHoursLeftColumn As Integer = 7
Const intCurrentStatusColumn As Integer = 8
Const intStartDateColumn As Integer = 9
Const intDueDateColumn As Integer = 10
Const intDueForColumn As Integer = 11
Const intPMColumn As Integer = 12
Const intNotesColumn As Integer = 13
Const intEffortColumn As Integer = 14
Const intContractorLength As Integer = 10
strPath = ThisWorkbook.ActiveSheet.Range("DirectoryName") & ThisWorkbook.ActiveSheet.Range("FileName")
Set PriorityExcel = New Excel.Application
With PriorityExcel 'open the "priority" file
.Workbooks.Open Filename:=strPath
Set myWorkbook = .ActiveWorkbook
End With
PriorityExcel.Visible = True ' turn this only only to see what is going on
' Process each name in the Individual range on the master spreadsheet
Set IndividualRange = ThisWorkbook.ActiveSheet.Range("Individuals")
For Each IndividualCell In IndividualRange
Select Case IndividualCell.Value
Case "start", "end" ' do not process the start and end keywords
Case Else
If blnDebug Then Debug.Print IndividualCell.Value ' print the value of the cell to see what it is
strIndividual = IndividualCell.Value ' save the cell value in a variable to make code easier to read
' process all sheets in the "slave" workbook
For Each PriorityWorksheet In PriorityExcel.ActiveWorkbook.Worksheets
If blnDebug Then Debug.Print PriorityWorksheet.Name
Select Case PriorityWorksheet.Name
Case "Calendar", "Awaiting approval" ' do not look for individuals on these two worksheets
Case Else
' let's go looking for the individual on the active sheet
PriorityExcel.Worksheets(PriorityWorksheet.Name).Activate
PriorityWorksheet.Range("B:B").AutoFilter _
field:=1, _
Criteria1:=strIndividual, _
VisibleDropDown:=False
' obtain the range of visible cells
Set PriorityRange = PriorityWorksheet.UsedRange.SpecialCells(xlCellTypeVisible)
' walk through each row
intPriorityCounter = 1
******************************************************************** this for each loop
For Each PriorityRow In PriorityRange.Rows
' skip the first row as this is the header and where
' the autofilter information is displayed
If PriorityRow.Row = 1 Then
Else
Debug.Print PriorityRow.Row ' I see row number 7 for example three times
End If
Next PriorityRow
************************************************************************
PriorityWorksheet.Range("A1").AutoFilter
End Select
Next PriorityWorksheet
End Select
Next IndividualCell
'Save and close the workbook and sheet
myWorkbook.Close savechanges:=xlSaveChanges
PriorityExcel.Quit
Set PriorityWorksheet = Nothing
Set myWorkbook = Nothing
Set PriorityExcel = Nothing
End Sub
Private Sub ProcessIndividuals()
Dim myWorkbook As Excel.Workbook
Dim strPath As String
Dim IndividualRange As Range
Dim IndividualCell As Range
Dim strIndividual As String
Dim intPriorityCounter As Integer
Dim PriorityExcel As Excel.Application
Dim PriorityWorksheet As Excel.Worksheet
Dim PriorityRange As Range
Dim PriorityRow As Range
Dim PriorityCell As Range
Const blnDebug As Boolean = True
Const intColumnOne As Integer = 1
Const intAssignToColumn As Integer = 2
Const intPriorityColumn As Integer = 3
Const intJobTicketColumn As Integer = 4
Const intTaskColumn As Integer = 5
Const intEstHrColumn As Integer = 6
Const intHoursLeftColumn As Integer = 7
Const intCurrentStatusColumn As Integer = 8
Const intStartDateColumn As Integer = 9
Const intDueDateColumn As Integer = 10
Const intDueForColumn As Integer = 11
Const intPMColumn As Integer = 12
Const intNotesColumn As Integer = 13
Const intEffortColumn As Integer = 14
Const intContractorLength As Integer = 10
strPath = ThisWorkbook.ActiveSheet.Range("DirectoryName") & ThisWorkbook.ActiveSheet.Range("FileName")
Set PriorityExcel = New Excel.Application
With PriorityExcel 'open the "priority" file
.Workbooks.Open Filename:=strPath
Set myWorkbook = .ActiveWorkbook
End With
PriorityExcel.Visible = True ' turn this only only to see what is going on
' Process each name in the Individual range on the master spreadsheet
Set IndividualRange = ThisWorkbook.ActiveSheet.Range("Individuals")
For Each IndividualCell In IndividualRange
Select Case IndividualCell.Value
Case "start", "end" ' do not process the start and end keywords
Case Else
If blnDebug Then Debug.Print IndividualCell.Value ' print the value of the cell to see what it is
strIndividual = IndividualCell.Value ' save the cell value in a variable to make code easier to read
' process all sheets in the "slave" workbook
For Each PriorityWorksheet In PriorityExcel.ActiveWorkbook.Worksheets
If blnDebug Then Debug.Print PriorityWorksheet.Name
Select Case PriorityWorksheet.Name
Case "Calendar", "Awaiting approval" ' do not look for individuals on these two worksheets
Case Else
' let's go looking for the individual on the active sheet
PriorityExcel.Worksheets(PriorityWorksheet.Name).Activate
PriorityWorksheet.Range("B:B").AutoFilter _
field:=1, _
Criteria1:=strIndividual, _
VisibleDropDown:=False
' obtain the range of visible cells
Set PriorityRange = PriorityWorksheet.UsedRange.SpecialCells(xlCellTypeVisible)
' walk through each row
intPriorityCounter = 1
******************************************************************** this for each loop
For Each PriorityRow In PriorityRange.Rows
' skip the first row as this is the header and where
' the autofilter information is displayed
If PriorityRow.Row = 1 Then
Else
Debug.Print PriorityRow.Row ' I see row number 7 for example three times
End If
Next PriorityRow
************************************************************************
PriorityWorksheet.Range("A1").AutoFilter
End Select
Next PriorityWorksheet
End Select
Next IndividualCell
'Save and close the workbook and sheet
myWorkbook.Close savechanges:=xlSaveChanges
PriorityExcel.Quit
Set PriorityWorksheet = Nothing
Set myWorkbook = Nothing
Set PriorityExcel = Nothing
End Sub