VBA: Locate row where 4 conditions are met

[Ottsel]

I have 2 workbooks total.

Workbook A, which has around 16000 rows + of data. Then Workbook B, which is the one I'm working in has an active directory list.

I have 3 rows of data. Column A, B, C, which should or is listed within both workbooks. I'm using an input box to find the date (where the forth condition comes into play).
Example:
Workbook A & B
Column A: DIS
Column B: ERT
Column C: 1100
Column D: 5/1/2023 / Inputbox answer (dimmed as Ans)

The information is in the same location for both workbooks and I made this macro, so it'll tell me if it can find it within Workbook A. If its unable to, then it'll post a note in column E saying "Unable to locate", so I know to go in and add it before I export my data to workbook A.

The main issue with this code is it is increditly slow. Does anyone here have any suggestions on how to improve its speed? I have 500 rows on Workbook B to check, so it'll take around 20-30 minutes to process.

Private Sub Lot_Blocks_Click()
    Dim lastRow As Long                                     
    Dim aws As Workbook                                         
    Dim ws As Worksheet                                       
    Dim i As Integer
    Dim Ans As String
    Dim msBldr As String
    Dim msTract As String
    Dim msLot As String
    Dim msDate As String
    Dim asBldr As String
    Dim asTract As String
    Dim asLot As String
    Dim asDate As String
    Dim c As Range
    Dim FoundLotBlock As Long
    
    Ans = InputBox("Please input the date." & vbCrLf & _
        "Example: 12/1/2017")
    If Ans = "" Then
        Exit Sub
    Else
        lastRow = Dirr.Range("A:A").Cells.SpecialCells(xlCellTypeConstants).Count
        Set ws = ThisWorkbook.Sheets("Directory")
        Set aws = Workbooks.Open(PathSetup.Range("C2"))

        For i = 1 To lastRow
            FoundLotBlock = 0
            For Each c In Columns("A").Cells
                msBldr = ws.Cells(i, 1).Value                              
                msTract = ws.Cells(i, 2).Value                              
                msLot = ws.Cells(i, 3).Value                               
                msDate = Ans                                            
                asBldr = aws.Sheets("CA Wip Master").Cells(c.Row, 1).Value  
                asTract = aws.Sheets("CA Wip Master").Cells(c.Row, 2).Value 
                asLot = aws.Sheets("CA Wip Master").Cells(c.Row, 3).Value  
                asDate = aws.Sheets("CA Wip Master").Cells(c.Row, 7).Value  
                If asBldr = msBldr And _
                    asTract = msTract And _
                    asLot = msLot And _
                    asDate = msDate Then
                        FoundLotBlock = 1
                End If
                If FoundBlock = 1 Then
                    GoTo ProceedForward
                End If
            Next c
ProceedForward:
            ws.Activate
            ws.Cells(i, 5).Select
            If FoundLotBlock = 1 Then
                ws.Cells(i, 5).Value = ""
            Else
                ws.Cells(i, 5).Value = "Action Required."
            End If
        Next i
    End If
    MsgBox "Check Complete!", vbOKOnly"
End Sub

 

[offthelip]

One of the main reasons that Vba is slow is the time taken to access the worksheet from VBa is a relatively long time.
To speed up vba the easiest way is to minimise the number of accesses to the worksheet. What is interesting is that the time taken to access a single cell on the worksheet in vba is almost identical as the time taken to access a large range if it is done in one action.

So instead of writing a loop which loops down a range copying one row at a time which will take along time if you have got 50000 rows it is much quicker to load the 50000 lines into a variant array ( one worksheet access), then copy the lines to a variant array and then write the array back to the worksheet, ( one worksheet access for each search that you are doing),

I have a simple rule for fast VBA: NEVER ACCESS THE WORKSHEET IN A LOOP.
In your code you have a DOUBLE loop so it is going to be very very slow. I have modified your code to load the data inot two varaint arrrays at the start and then do the loops without accessing the worksheets this should be over 1000 times faster, .
Anotehr thing to be wary of when writing loops is to avoid putting statement into the loop that doesn't need to be in the loop You can see that I have moved a number of your statements out of the loops because the variable doesn't change inside the innermost loop or in the case of ANS both loops.
Note code is untested:

Private Sub Lot_Blocks_Click()
    Dim lastRow As Long
    Dim aws As Workbook
    Dim ws As Worksheet
    Dim i As Integer
    Dim Ans As String
    Dim msBldr As String
    Dim msTract As String
    Dim msLot As String
    Dim msDate As String
    Dim asBldr As String
    Dim asTract As String
    Dim asLot As String
    Dim asDate As String
    Dim c As Range
    Dim FoundLotBlock As Long
   
    Ans = InputBox("Please input the date." & vbCrLf & _
        "Example: 12/1/2017")
    If Ans = "" Then
        Exit Sub
    Else
        lastRow = Dirr.Range("A:A").Cells.SpecialCells(xlCellTypeConstants).Count  ' I don't know what this was doing!!! DIRR seems undefined!!
        Set ws = ThisWorkbook.Sheets("Directory")
        Set aws = Workbooks.Open(PathSetup.Range("C2"))
        With aws.Sheets("CA Wip Master")                                              '
          Awslr = .Cells(Rows.Count, "A").End(xlUp).Row       'load all the data on aws sheet into a variant array
          awsarr = .Range(.Cells(1, 1).Cells(Awslr, , 7))      '
        End With
       
       
        With ws                                              '
          wslr = .Cells(Rows.Count, "A").End(xlUp).Row       'load all the data on ws sheet into a variant array
          wsarr = .Range(.Cells(1, 1).Cells(wslr, , 5))      '
       
                msDate = Ans                      ' move this out of both loops
       
        For i = 1 To lastRow
            FoundLotBlock = 0
'            For Each c In Columns("A").Cells  ' move this down because the next statements don't need to be inside this loop
                msBldr = wsarr(i, 1)
                msTract = wsarr(i, 2)
                msLot = wsarr(i, 3)
'                msDate = Ans                      ' move this out of both loops
'            For Each c In Columns("A").Cells  ' move this dwon because the next statements don't need to be inside this loop
             For j = 1 To Awslr
                asBldr = awsarr(j, 1)
                asTract = awsarr(j, 2)
                asLot = awsarr(j, 3)
                asDate = awsarr(j, 7)
                If asBldr = msBldr And _
                    asTract = msTract And _
                    asLot = msLot And _
                    asDate = msDate Then
                        FoundLotBlock = 1
                End If
                If FoundBlock = 1 Then
                    GoTo ProceedForward
                End If
            Next j
ProceedForward:
 '           ws.Activate
 '           wsarr(i, 5).Select
            If FoundLotBlock = 1 Then
                wsarr(i, 5) = ""
            Else
                wsarr(i, 5) = "Action Required."
            End If
        Next i
          .Range(.Cells(1, 1).Cells(wslr, , 5)) = wsarr   ' write array back to workshseet
         
        End With
   
   
    End If
    MsgBox "Check Complete!", vbOKOnly
End Sub

 

[Ottsel]

One of the main reasons that Vba is slow is the time taken to access the worksheet from VBa is a relatively long time.
To speed up vba the easiest way is to minimise the number of accesses to the worksheet. What is interesting is that the time taken to access a single cell on the worksheet in vba is almost identical as the time taken to access a large range if it is done in one action.

So instead of writing a loop which loops down a range copying one row at a time which will take along time if you have got 50000 rows it is much quicker to load the 50000 lines into a variant array ( one worksheet access), then copy the lines to a variant array and then write the array back to the worksheet, ( one worksheet access for each search that you are doing),

I have a simple rule for fast VBA: NEVER ACCESS THE WORKSHEET IN A LOOP.
In your code you have a DOUBLE loop so it is going to be very very slow. I have modified your code to load the data inot two varaint arrrays at the start and then do the loops without accessing the worksheets this should be over 1000 times faster, .
Anotehr thing to be wary of when writing loops is to avoid putting statement into the loop that doesn't need to be in the loop You can see that I have moved a number of your statements out of the loops because the variable doesn't change inside the innermost loop or in the case of ANS both loops.
Note code is untested:

Private Sub Lot_Blocks_Click()
    Dim lastRow As Long
    Dim aws As Workbook
    Dim ws As Worksheet
    Dim i As Integer
    Dim Ans As String
    Dim msBldr As String
    Dim msTract As String
    Dim msLot As String
    Dim msDate As String
    Dim asBldr As String
    Dim asTract As String
    Dim asLot As String
    Dim asDate As String
    Dim c As Range
    Dim FoundLotBlock As Long
  
    Ans = InputBox("Please input the date." & vbCrLf & _
        "Example: 12/1/2017")
    If Ans = "" Then
        Exit Sub
    Else
        lastRow = Dirr.Range("A:A").Cells.SpecialCells(xlCellTypeConstants).Count  ' I don't know what this was doing!!! DIRR seems undefined!!
        Set ws = ThisWorkbook.Sheets("Directory")
        Set aws = Workbooks.Open(PathSetup.Range("C2"))
        With aws.Sheets("CA Wip Master")                                              '
          Awslr = .Cells(Rows.Count, "A").End(xlUp).Row       'load all the data on aws sheet into a variant array
          awsarr = .Range(.Cells(1, 1).Cells(Awslr, , 7))      '
        End With
      
      
        With ws                                              '
          wslr = .Cells(Rows.Count, "A").End(xlUp).Row       'load all the data on ws sheet into a variant array
          wsarr = .Range(.Cells(1, 1).Cells(wslr, , 5))      '
      
                msDate = Ans                      ' move this out of both loops
      
        For i = 1 To lastRow
            FoundLotBlock = 0
'            For Each c In Columns("A").Cells  ' move this down because the next statements don't need to be inside this loop
                msBldr = wsarr(i, 1)
                msTract = wsarr(i, 2)
                msLot = wsarr(i, 3)
'                msDate = Ans                      ' move this out of both loops
'            For Each c In Columns("A").Cells  ' move this dwon because the next statements don't need to be inside this loop
             For j = 1 To Awslr
                asBldr = awsarr(j, 1)
                asTract = awsarr(j, 2)
                asLot = awsarr(j, 3)
                asDate = awsarr(j, 7)
                If asBldr = msBldr And _
                    asTract = msTract And _
                    asLot = msLot And _
                    asDate = msDate Then
                        FoundLotBlock = 1
                End If
                If FoundBlock = 1 Then
                    GoTo ProceedForward
                End If
            Next j
ProceedForward:
 '           ws.Activate
 '           wsarr(i, 5).Select
            If FoundLotBlock = 1 Then
                wsarr(i, 5) = ""
            Else
                wsarr(i, 5) = "Action Required."
            End If
        Next i
          .Range(.Cells(1, 1).Cells(wslr, , 5)) = wsarr   ' write array back to workshseet
        
        End With
  
  
    End If
    MsgBox "Check Complete!", vbOKOnly
End Sub

I greatly appreciate the info and suggestions! Trying to make sense of this.

Encountering an issue here:

awsarr = .Range(.Cells(1, 1).Cells(Awslr, , 7))       '...encountering an issue here. Trying to figure it out

Everything together this is where I'm at with your revisions:

Private Sub Lot_Blocks_Click()
    Dim lastRow As Long
    Dim aws As Workbook
    Dim ws As Worksheet
    Dim i, j As Integer
    Dim Ans As String
    Dim msBldr As String
    Dim msTract As String
    Dim msLot As String
    Dim msDate As String
    Dim asBldr As String
    Dim asTract As String
    Dim asLot As String
    Dim asDate As String
    Dim c As Range
    Dim FoundBlock As Long
    Dim Awslr As Long                       '...added
    Dim awsarr As Variant                   '...added
    Dim wslr As Long                        '...added
    Dim wsarr As Variant                    '...added

    Ans = InputBox("Please input the date." & vbCrLf & _
        "Example: 12/1/2017")
    If Ans = "" Then
        Exit Sub
    Else
        lastRow = Dirr.Range("A:A").Cells.SpecialCells(xlCellTypeConstants).Count  '...Dirr = name of worksheet
        Set ws = ThisWorkbook.Sheets("Directory")
        Set aws = Workbooks.Open(PathSetup.Range("C2"))
        With aws.Sheets("CA Wip Master")                                              '
          Awslr = .Cells(Rows.Count, "A").End(xlUp).Row         'load all the data on aws sheet into a variant array
          awsarr = .Range(.Cells(1, 1).Cells(Awslr, , 7))       '...encountering an issue here. Trying to figure it out
        End With
       
        With ws                                                 '
          wslr = .Cells(Rows.Count, "A").End(xlUp).Row          'load all the data on ws sheet into a variant array
          wsarr = .Range(.Cells(1, 1).Cells(wslr, , 5))         '
       
                msDate = Ans                                    ' move this out of both loops
       
        For i = 1 To lastRow
            FoundBlock = 0
'            For Each c In Columns("A").Cells                   ' move this down because the next statements don't need to be inside this loop
                msBldr = wsarr(i, 1)
                msTract = wsarr(i, 2)
                msLot = wsarr(i, 3)
'                msDate = Ans                                   ' move this out of both loops
'            For Each c In Columns("A").Cells                   ' move this dwon because the next statements don't need to be inside this loop
             For j = 1 To Awslr
                asBldr = awsarr(j, 1)
                asTract = awsarr(j, 2)
                asLot = awsarr(j, 3)
                asDate = awsarr(j, 7)                           '...where does the 7 come into play?
                If asBldr = msBldr And _
                    asTract = msTract And _
                    asLot = msLot And _
                    asDate = msDate Then
                        FoundBlock = 1
                End If
                If FoundBlock = 1 Then
                    GoTo ProceedForward
                End If
            Next j
ProceedForward:
 '           ws.Activate
 '           wsarr(i, 5).Select
            If FoundBlock = 1 Then
                wsarr(i, 5) = ""
            Else
                wsarr(i, 5) = "Action Required."
            End If
        Next i
          .Range(.Cells(1, 1).Cells(wslr, , 5)) = wsarr         ' write array back to workshseet
         
        End With
   
   
    End If
    MsgBox "Check Complete!", vbOKOnly
End Sub

 

[offthelip]

you have got two commas which is probably the problem, sorry my mistake( I said it was untested0
ditto on this line:

.Range(.Cells(1, 1).Cells(wslr, , 5)) = wsarr         ' write array back to workshseet

check them all, I did a bit of copy and paste

 

[offthelip]

asDate = awsarr(j, 7) '...where does the 7 come into play?
the 7 comes into play because this line is exactly equivalent to this line in your orginal code:

 asDate = aws.Sheets("CA Wip Master").Cells(c.Row, 7).Value

I actually did the change by using a global change of "aws.Sheets("CA Wip Master").Cells(c.Row" to"awsarr(j"
very easy to do,
and then ".Value" to ""
as you can see using variant arrays can be faster to write as well as being faster to run!!

 

[offthelip]

Another modification which you should consider. is the GOTO statement is generally frowned on as being likely to end up making code very difficult to maintain. you are using it just to exit a loop:

                       FoundLotBlock = 1
                End If
                If FoundBlock = 1 Then
                    GoTo ProceedForward
                End If

there is a very useful bit code you can use instead of this;

  Exit For
 End  If

this is exactly equivalent to the code I posted above

 

[Georgiboy]

May not be of any help but you may also be able to do this with a IF/COUNTIFS formula:

=IF(COUNTIFS([Book2]Sheet1!$A2:$A8,A2:A20,[Book2]Sheet1!$B2:$B8,B2:B20,[Book2]Sheet1!$C2:$C8,C2:C20)<1,"ADD","")

 

[Ottsel]

May not be of any help but you may also be able to do this with a IF/COUNTIFS formula:

=IF(COUNTIFS([Book2]Sheet1!$A2:$A8,A2:A20,[Book2]Sheet1!$B2:$B8,B2:B20,[Book2]Sheet1!$C2:$C8,C2:C20)<1,"ADD","")

surprisingly, i used this idea to make the macro run a lot smoother. I could not figure out the directory for the life of me. Its tacky, but works a lot faster.

Private Sub Lot_Blocks_Click()
    Dim i As Long
    Dim aws As Workbook
    Dim AccRow As Long
    Dim lastRow As Long
    Dim FileName As String
    Dim cFormula As String
    
    Set aws = Workbooks.Open(PathSetup.Range("C2"))
    AccRow = aws.Sheets("CA Wip Master").Range("A:A").Cells(Rows.Count, 1).End(xlUp).Row
    lastRow = Dirr.Range("A:A").Cells.SpecialCells(xlCellTypeConstants).Count
    FileName = PathSetup.Range("C3").Value
    
    If Labor_From.Value > 0 Then
        '...format column for inputs
        Dirr.Columns("E:E").ColumnWidth = 27.86
        '...input date
        Dirr.Range("D1" & ":" & "D" & lastRow).Value = Labor_From.Value
        '...insert checklist
        For i = 1 To lastRow
            cFormula = "=IF(COUNTIFS('[" + FileName & "]CA Wip Master'!$A$1:$A$" & AccRow & ",A" & i & _
                ",'[" + FileName & "]CA Wip Master'!$B$1:$B$" & AccRow & ",B" & i & _
                ",'[" + FileName & "]CA Wip Master'!$C$1:$C$" & AccRow & ",C" & i & _
                ",'[" + FileName & "]CA Wip Master'!$G$1:$G$" & AccRow & ",D" & i & _
                ")<1,""Action Required."","""")"
            If Dirr.Cells(i, 5).Value = "" Then
                Dirr.Cells(i, 5).Value = cFormula
            End If
        Next i
        
        '...Clear out Formulas
        Dirr.Columns("E:E").Copy
        Dirr.Columns("E:E").PasteSpecial Paste:=xlPasteValues
        Dirr.Activate
            Range("E1").Select
        Application.CutCopyMode = False
        MsgBox "Check Complete!", vbOKOnly
    Else
        MsgBox "Enter a date first into the Labor"
    End If
End Sub

 

[Ottsel]

asDate = awsarr(j, 7) '...where does the 7 come into play?

the 7 comes into play because this line is exactly equivalent to this line in your orginal code:

 asDate = aws.Sheets("CA Wip Master").Cells(c.Row, 7).Value

I actually did the change by using a global change of "aws.Sheets("CA Wip Master").Cells(c.Row" to"awsarr(j"
very easy to do,
and then ".Value" to ""
as you can see using variant arrays can be faster to write as well as being faster to run!!

Appreciate all the information, but I couldn't figure out how to get the directory to work. I had to use another method, but thank you for everything!