VBA For loops multiple conditions

79 Views Asked by At

The task of this For loop would be to collect data from the two worksheets and use it in a user form. In the first part, the data should be copied if the EmplID and today's date match. If this condition is not met, only the EmplID and name will be copied. Unfortunately, this does not work and the first condition is fulfilled in all cases.

If EmplID.Text = "" Then
MsgBox "Please enter your ID", vbCritical, "Alert"
Exit Sub
End If

Application.ScreenUpdating = False

Dim Empl_ID As String, found As Boolean
Dim lrow As Long, srow As Long, s As Date, i As Long, x As Long

Empl_ID = Trim(EmplID.Text)

lrow = Sheets("DatabaseIN").Cells(Rows.Count, "A").End(xlUp).Row
srow = Sheets("Stamp").Cells(Rows.Count, "A").End(xlUp).Row
s = Format(Date, "yyyy/mm/dd")

found = False


For i = 2 To lrow
    For x = 2 To srow
        If Sheets("DatabaseIN").Cells(i, 1).Value = Empl_ID And _
           Sheets("Stamp").Cells(x, 3).Value = Date Then

            txtName = Sheets("Stamp").Cells(x, 2).Value
            txtDate = Sheets("Stamp").Cells(x, 3).Text
            txtStart = Sheets("Stamp").Cells(x, 4).Text
            txtBreakOut = Sheets("Stamp").Cells(x, 5).Text
            txtBreakIn = Sheets("Stamp").Cells(x, 6).Text
            txtEnd = Sheets("Stamp").Cells(x, 7).Text
            found = True
            Exit For ' Kilépünk a belso ciklusból, mivel már megtaláltuk a megfelelo rekordot
        End If
    Next x
    
    If found Then
        Exit For ' Kilépünk a külso ciklusból is, mivel már megtaláltuk a megfelelo rekordot
    ElseIf Sheets("DatabaseIN").Cells(i, 1).Value = Empl_ID Then
        txtName = Sheets("DatabaseIN").Cells(i, 2).Value
        txtDate = s
    End If
Next i


1

There are 1 best solutions below

2
Tim Williams On BEST ANSWER

For example, without the nested loop and using Match() for lookups:

Sub Tester()
    
    Dim Empl_ID As String, found As Boolean
    Dim lrow As Long, srow As Long, s As Date, i As Long, x As Long
    Dim wsDBIn As Worksheet, wsStamp As Worksheet, mId, mDt

    Empl_ID = Trim(EmplID.Text)
    If Len(Empl_ID) = 0 Then
        MsgBox "Please enter your ID", vbCritical, "Alert"
        Exit Sub
    End If
    
    Application.ScreenUpdating = False
    
    Set wsDBIn = ThisWorkbook.Worksheets("DatabaseIN")
    Set wsStamp = ThisWorkbook.Worksheets("Stamp")
    
    mId = Application.Match(Empl_ID, wsDBIn.Columns("A"), 0)     'look for Id match
    mDt = Application.Match(CLng(Date), wsStamp.Columns("C"), 0) 'convert to Long for date matching...
    
    If Not IsError(mId) Then                'got a match on Id?
        txtName = wsDBIn.Cells(mId, 2).Value
        txtDate = Format(Date, "yyyy/mm/dd")
        
        If Not IsError(mDt) Then            'got a match on Date?
            txtStart = wsStamp.Cells(mDt, 4).Text
            txtBreakOut = wsStamp.Cells(mDt, 5).Text
            txtBreakIn = wsStamp.Cells(mDt, 6).Text
            txtEnd = wsStamp.Cells(mDt, 7).Text
        End If
    End If
    
End Sub