VBA - 'Find' Method Within 'For Each' Loop

Legacy 458280 · Apr 24, 2020

Hi,

I'm having a bit of trouble using a 'find' method within a 'for each' loop. The code works perfectly, except where it finds repeated values, it only executes on the first instance.

Quick overview:

This is a project scheduling document. This piece of code (which runs via the press of a button) is supposed to delete the currently selected project (in the 'Projects' sheet) as well as deleting any reference to that project from the 'Board' and 'Resource Assignment' sheets. The board is the primary interface, whilst the 'Projects' and 'Resource Assignment' sheets serve as primitive databases.

Here is the code:

VBA Code:

Private Sub CommandButton3_Click()
Static selectRow As Range
Dim projectNum As String

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Call UnProtectAllSheets
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
If Selection.Rows.Count > 1 Then
    MsgBox "Please only select one row at a time.", vbOKOnly, "Multiple Rows Selected"
    Call ProtectAllSheets
    Exit Sub
End If

If Selection.Row < 3 Then
    MsgBox "Please select a project.", vbOKOnly, "Invalid Selection"
    Call ProtectAllSheets
    Exit Sub
End If

Set selectRow = Selection.EntireRow

projectNum = selectRow.Cells(1, 1).Value

If projectNum = "" Then
    MsgBox "Please select a valid project.", vbOKOnly, "Invalid Selection"
    Call ProtectAllSheets
    Exit Sub
End If

If projectNum = "HOL" Then
    MsgBox "The 'Holiday' row cannot be deleted.  This is used to assign holidays to site employees.", vbOKOnly, "Invalid Selection"
    Call ProtectAllSheets
    Exit Sub
End If

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Dim assignmentSheet As Worksheet
Dim boardSheet As Worksheet
Dim assignmentLR As Long
Dim assignmentRange As Range
Dim assignmentSearchRow As Range
Dim resourceAssignmentEmployee As String
Dim resourceAssignmentStart As Date
Dim resourceAssignmentEnd As Date
Dim boardEmployeeRow As Long
Dim boardLR As Long
Dim boardEmployeeRange As Range
Dim boardStartColumn As Long
Dim boardEndColumn As Long
Dim find_start As String
Dim find_end As String
Dim boardLC As Long
Dim boardDateRange As Range
Dim boardAssignmentCellStart As Range
Dim boardAssignmentCellEnd As Range
Dim boardAssignmentRange As Range
Dim ColLet As String

Set assignmentSheet = ThisWorkbook.Sheets("Resource Assignment")
Set boardSheet = ThisWorkbook.Sheets("Board")
assignmentLR = assignmentSheet.Cells(Rows.Count, "B").End(xlUp).Row
Set assignmentRange = assignmentSheet.Range("A" & 3 & ":D" & assignmentLR)
boardLR = boardSheet.Cells(Rows.Count, "B").End(xlUp).Row
Set boardEmployeeRange = boardSheet.Range("B" & 4 & ":B" & boardLR)
boardLC = boardSheet.Cells(3, Columns.Count).End(xlToLeft).Column
ColLet = Split(Cells(1, boardLC).Address, "$")(1)
Set boardDateRange = boardSheet.Range("C" & 3 & ":" & ColLet & 3)

For Each assignmentSearchRow In assignmentRange.Rows
    If assignmentSearchRow.Cells(1, 2).Value = projectNum Then
        resourceAssignmentEmployee = assignmentSearchRow.Cells(1, 1).Value
        resourceAssignmentStart = assignmentSearchRow.Cells(1, 3).Value
        resourceAssignmentEnd = assignmentSearchRow.Cells(1, 4).Value
        find_start = Format(resourceAssignmentStart, "Short Date")
        find_end = Format(resourceAssignmentEnd, "Short Date")
        boardEmployeeRow = boardEmployeeRange.Find(What:=resourceAssignmentEmployee, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows).Row
        boardStartColumn = boardDateRange.Find(What:=CDate(find_start), LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByColumns).Column
        boardEndColumn = boardDateRange.Find(What:=CDate(find_end), LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByColumns).Column
        Set boardAssignmentCellStart = boardSheet.Cells(boardEmployeeRow, boardStartColumn)
        Set boardAssignmentCellEnd = boardSheet.Cells(boardEmployeeRow, boardEndColumn)
        Set boardAssignmentRange = boardSheet.Range(boardAssignmentCellStart, boardAssignmentCellEnd)
        boardAssignmentRange.Interior.Color = xlNone
        boardAssignmentRange.ClearContents
        boardAssignmentRange.ClearComments
        boardAssignmentRange.ClearNotes
        boardAssignmentRange.HorizontalAlignment = xlCenter
        assignmentSearchRow.EntireRow.Delete
    End If
Next assignmentSearchRow

selectRow.Delete

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Call ProtectAllSheets
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
End Sub

I have attached screenshots for reference (names have been removed). As you can see on the 'Board' sheet, some employees have multiple instances of the same project against their name (i.e. employee on row 11 working on Project 1234 on 28th Jan, then has a few days off before returning to Project 1234 again from 3rd-4th Feb). In this case, one of the blocks will be removed from the board (and also removed from the resource assignment sheet), but the other one won't. I assume this is down to the 'For Each' loop only picking up on the FIRST result from the find method contained within the 'if' statement, though I haven't had any luck with resolving it.

Any suggestions would be greatly appreciated.

Thanks,
Luke

MARK858 · Apr 24, 2020

Hi Luke, afraid that I haven't got time at the moment to write code but if you want to search for multiple entries using Find then you don't normally use a For each loop, you normally use the FindNext option.
An example of a find next is below...

Rich (BB code):

Sub FindIt()
    Dim fCell As Range, lCell As Range, fAddr As String
   
    With Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row)
        Set lCell = .Cells(.Cells.Count)

        Set fCell = .Find(What:="Value to Find", After:=lCell, LookIn:=xlValues, LookAt:= _
                          xlPart, SearchOrder:=xlByRows)

        If Not fCell Is Nothing Then
            fAddr = fCell.Address
        End If

        Do Until fCell Is Nothing
            fCell.Interior.ColorIndex = 6 'Action to be taken here
            Set fCell = .FindNext(After:=fCell)
            If fCell.Address = fAddr Then
                Exit Do
            End If
        Loop
    End With
End Sub

Legacy 458280 · Apr 27, 2020

Mark,

Thanks for your response. I had a go at applying your code, although I think I may have gone wrong somewhere. It causes Excel to freeze and makes the screen flicker occasionally. I imagine it is an error in applying your code to my situation (I'm not familiar with the FindNext method).

Here's my code so far:

VBA Code:

Private Sub CommandButton3_Click()
Static selectRow As Range
Dim projectNum As String

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Call UnProtectAllSheets
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
If Selection.Rows.Count > 1 Then
    MsgBox "Please only select one row at a time.", vbOKOnly, "Multiple Rows Selected"
    Call ProtectAllSheets
    Exit Sub
End If

If Selection.Row < 3 Then
    MsgBox "Please select a project.", vbOKOnly, "Invalid Selection"
    Call ProtectAllSheets
    Exit Sub
End If

Set selectRow = Selection.EntireRow

projectNum = selectRow.Cells(1, 1).Value

If projectNum = "" Then
    MsgBox "Please select a valid project.", vbOKOnly, "Invalid Selection"
    Call ProtectAllSheets
    Exit Sub
End If

If projectNum = "HOL" Then
    MsgBox "The 'Holiday' row cannot be deleted.  This is used to assign holidays to site employees.", vbOKOnly, "Invalid Selection"
    Call ProtectAllSheets
    Exit Sub
End If

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Dim assignmentSheet As Worksheet
Dim boardSheet As Worksheet
Dim assignmentLR As Long
Dim assignmentRange As Range
Dim assignmentSearchRow As Range
Dim resourceAssignmentEmployee As String
Dim resourceAssignmentStart As Date
Dim resourceAssignmentEnd As Date
Dim boardEmployeeRow As Long
Dim boardLR As Long
Dim boardEmployeeRange As Range
Dim boardStartColumn As Long
Dim boardEndColumn As Long
Dim find_start As String
Dim find_end As String
Dim boardLC As Long
Dim boardDateRange As Range
Dim boardAssignmentCellStart As Range
Dim boardAssignmentCellEnd As Range
Dim boardAssignmentRange As Range
Dim ColLet As String

Set assignmentSheet = ThisWorkbook.Sheets("Resource Assignment")
Set boardSheet = ThisWorkbook.Sheets("Board")
assignmentLR = assignmentSheet.Cells(Rows.Count, "B").End(xlUp).Row
Set assignmentRange = assignmentSheet.Range("A" & 3 & ":D" & assignmentLR)
boardLR = boardSheet.Cells(Rows.Count, "B").End(xlUp).Row
Set boardEmployeeRange = boardSheet.Range("B" & 4 & ":B" & boardLR)
boardLC = boardSheet.Cells(3, Columns.Count).End(xlToLeft).Column
ColLet = Split(Cells(1, boardLC).Address, "$")(1)
Set boardDateRange = boardSheet.Range("C" & 3 & ":" & ColLet & 3)

 Dim fCell As Range, lCell As Range, fAddr As String
  
    With assignmentRange
        Set lCell = .Cells(.Cells.Count)

        Set fCell = .Find(What:=projectNum, After:=lCell, LookIn:=xlValues, LookAt:= _
                          xlWhole, SearchOrder:=xlByRows)

        If Not fCell Is Nothing Then
            fAddr = fCell.Address
        End If

        Do Until fCell Is Nothing
            resourceAssignmentEmployee = fCell.EntireRow.Cells(1, 1).Value
            resourceAssignmentStart = fCell.EntireRow.Cells(1, 3).Value
            resourceAssignmentEnd = fCell.EntireRow.Cells(1, 4).Value
            find_start = Format(resourceAssignmentStart, "Short Date")
            find_end = Format(resourceAssignmentEnd, "Short Date")
            boardEmployeeRow = boardEmployeeRange.Find(What:=resourceAssignmentEmployee, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows).Row
            boardStartColumn = boardDateRange.Find(What:=CDate(find_start), LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByColumns).Column
            boardEndColumn = boardDateRange.Find(What:=CDate(find_end), LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByColumns).Column
            Set boardAssignmentCellStart = boardSheet.Cells(boardEmployeeRow, boardStartColumn)
            Set boardAssignmentCellEnd = boardSheet.Cells(boardEmployeeRow, boardEndColumn)
            Set boardAssignmentRange = boardSheet.Range(boardAssignmentCellStart, boardAssignmentCellEnd)
            boardAssignmentRange.Interior.Color = xlNone
            boardAssignmentRange.ClearContents
            boardAssignmentRange.ClearComments
            boardAssignmentRange.ClearNotes
            boardAssignmentRange.HorizontalAlignment = xlCenter
            Set fCell = .FindNext(After:=fCell)
            If fCell.Address = fAddr Then
            fCell.EntireRow.Delete
                Exit Do
            End If
        Loop
    End With

selectRow.Delete

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Call ProtectAllSheets
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
End Sub

Any suggestions?

Thanks again for your help,
Luke

MARK858 · Apr 27, 2020

I commented out any bits not concerned with the loop, assigned a couple of hard values and replaced the bits that you had in the place where the action is taking place with a simple highlight the cell with test in it and the code highlighted all the cells correctly (see the image below).
This means the Find loop isn't the issue and I would recommend stepping though the code with F8 so you can see what is happening (make sure the screenupdating isn't set to FALSE when you are doing this.

Code that I ran

VBA Code:

Sub xxxx()
'Static selectRow As Range
Dim projectNum As String

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Call UnProtectAllSheets
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'If Selection.Rows.Count > 1 Then
'    MsgBox "Please only select one row at a time.", vbOKOnly, "Multiple Rows Selected"
'    Call ProtectAllSheets
'    Exit Sub
'End If
'
'If Selection.Row < 3 Then
'    MsgBox "Please select a project.", vbOKOnly, "Invalid Selection"
'    Call ProtectAllSheets
'    Exit Sub
'End If
'
'Set selectRow = Selection.EntireRow
'
projectNum = "test"  'selectRow.Cells(1, 1).Value

'If projectNum = "" Then
'    MsgBox "Please select a valid project.", vbOKOnly, "Invalid Selection"
'    Call ProtectAllSheets
'    Exit Sub
'End If
'
'If projectNum = "HOL" Then
'    MsgBox "The 'Holiday' row cannot be deleted.  This is used to assign holidays to site employees.", vbOKOnly, "Invalid Selection"
'    Call ProtectAllSheets
'    Exit Sub
'End If

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Dim assignmentSheet As Worksheet
'Dim boardSheet As Worksheet
Dim assignmentLR As Long
Dim assignmentRange As Range
Dim assignmentSearchRow As Range
'Dim resourceAssignmentEmployee As String
'Dim resourceAssignmentStart As Date
'Dim resourceAssignmentEnd As Date
'Dim boardEmployeeRow As Long
'Dim boardLR As Long
'Dim boardEmployeeRange As Range
'Dim boardStartColumn As Long
'Dim boardEndColumn As Long
'Dim find_start As String
'Dim find_end As String
'Dim boardLC As Long
'Dim boardDateRange As Range
'Dim boardAssignmentCellStart As Range
'Dim boardAssignmentCellEnd As Range
'Dim boardAssignmentRange As Range
'Dim ColLet As String

Set assignmentSheet = ThisWorkbook.Sheets("Resource Assignment")
'Set boardSheet = ThisWorkbook.Sheets("Board")
assignmentLR = assignmentSheet.Cells(Rows.Count, "B").End(xlUp).Row
Set assignmentRange = assignmentSheet.Range("A" & 3 & ":D" & assignmentLR)
'boardLR = boardSheet.Cells(Rows.Count, "B").End(xlUp).Row
'Set boardEmployeeRange = boardSheet.Range("B" & 4 & ":B" & boardLR)
'boardLC = boardSheet.Cells(3, Columns.Count).End(xlToLeft).Column
'ColLet = Split(Cells(1, boardLC).Address, "$")(1)
'Set boardDateRange = boardSheet.Range("C" & 3 & ":" & ColLet & 3)

 Dim fCell As Range, lCell As Range, fAddr As String
 
    With assignmentRange
        Set lCell = .Cells(.Cells.Count)

        Set fCell = .Find(What:=projectNum, After:=lCell, LookIn:=xlValues, LookAt:= _
                          xlWhole, SearchOrder:=xlByRows)

        If Not fCell Is Nothing Then
            fAddr = fCell.Address
        End If

        Do Until fCell Is Nothing
        fCell.Interior.ColorIndex = 6
'            resourceAssignmentEmployee = fCell.EntireRow.Cells(1, 1).Value
'            resourceAssignmentStart = fCell.EntireRow.Cells(1, 3).Value
'            resourceAssignmentEnd = fCell.EntireRow.Cells(1, 4).Value
'            find_start = Format(resourceAssignmentStart, "Short Date")
'            find_end = Format(resourceAssignmentEnd, "Short Date")
'            boardEmployeeRow = boardEmployeeRange.Find(What:=resourceAssignmentEmployee, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows).Row
'            boardStartColumn = boardDateRange.Find(What:=CDate(find_start), LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByColumns).Column
'            boardEndColumn = boardDateRange.Find(What:=CDate(find_end), LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByColumns).Column
'            Set boardAssignmentCellStart = boardSheet.Cells(boardEmployeeRow, boardStartColumn)
'            Set boardAssignmentCellEnd = boardSheet.Cells(boardEmployeeRow, boardEndColumn)
'            Set boardAssignmentRange = boardSheet.Range(boardAssignmentCellStart, boardAssignmentCellEnd)
'            boardAssignmentRange.Interior.Color = xlNone
'            boardAssignmentRange.ClearContents
'            boardAssignmentRange.ClearComments
'            boardAssignmentRange.ClearNotes
'            boardAssignmentRange.HorizontalAlignment = xlCenter
            Set fCell = .FindNext(After:=fCell)
            If fCell.Address = fAddr Then
'            fCell.EntireRow.Delete
                Exit Do
            End If
        Loop
    End With

'selectRow.Delete
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Call ProtectAllSheets
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
End Sub

Result that I got...

Book1

A

B

C

D

1

2

test

3

test

87

test

hh

4

39

1

test

5

test

15

78

68

6

13

47

3

34

7

22

8

85

77

8

37

87

2

17

9

82

test

5

31

10

58

26

10

71

11

75

84

14

98

12

72

6

8

86

13

30

49

test

38

14

37

80

85

26

15

test

94

25

79

16

69

11

test

17

78

51

46

10

18

test

46

61

22

19

test

Resource Assignment

Legacy 458280 · Apr 28, 2020

Ah, sorted. Thanks for your help.

VBA - 'Find' Method Within 'For Each' Loop

Legacy 458280

Guest

Attachments

Excel Facts

MARK858

MrExcel MVP

Legacy 458280

Guest

MARK858

MrExcel MVP

Legacy 458280

Guest

Forum statistics

Share this page

VBA - 'Find' Method Within 'For Each' Loop

Legacy 458280

Guest

Attachments

Excel Facts

MARK858

MrExcel MVP

Legacy 458280

Guest

MARK858

MrExcel MVP

Legacy 458280

Guest

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