Find with If Else not working correctly.

StvOne

New Member
Joined
Mar 20, 2017
Messages
18
Hi, I cannot seem to make my check in/out form work as needed. The issue or issues are when I scan into sheet 3 I find a value in a range. If found column c and d are copied to sheet 4 next available row. This part works. Issue 1: I need to look at sheet 4 column A and if copied value column C now residing in column A of sheet 4 exists then check column F on sheet 4 of same row for a date. If no date then fill row/column with (Now) and Number format. Issue 2: Same function, find value in column A and if a date does exist in column F then a new row is started with checked out date in column (E). I am using If Else to try and make this work and also tried Case but my limited skills are keeping me from completing this. Part of issue 1: If column F is filled in with a date then column D needs to be overwritten with the name of person checking in. The name if also found scanning into sheet 2 using a table and copying name over to sheet 4 column D. Not sure if holding a value until something else happens is possible in excel. Sheet 3 code is shown below. Sorry, I know indents are all over. As I indicated, Limited!! vba is very new to me.

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim FindString As String
Dim FindStringID As String
Dim Rng As Range
Dim bcr As Range
Dim nr As Long
Dim nc As Long
Dim irow As Long
Dim Standard As String
Dim Description As String
Dim rng1 As Range
Dim Response As Integer
Set ws = Worksheets("Report")
    If Target <> Range("A1") Then
        MsgBox ("You can only scan Barcodes into Sheet3 range A1")
        ActiveCell.ClearContents
        Range("A1").Select
    End If
        If Intersect(Target, Range("A1")) Is Nothing Then Exit Sub
        If Target = "" Then Exit Sub
        With Application
        .EnableEvents = False
        .ScreenUpdating = False
    
    'Find cell A1 value in column B and populate sheet 4 report
            FindString = Sheets("StandardTable").Range("A1")
            If Trim(FindString) <> "" Then
            With Sheets("StandardTable").Range("B2:B500")
            Set Rng = .Find(What:=FindString, _
                After:=.Cells(.Cells.Count), _
                LookIn:=xlValues, _
                LookAt:=xlWhole, _
                SearchOrder:=xlByRows, _
                SearchDirection:=xlNext, _
                MatchCase:=False)
            End With
            End If
     'Collect Standard Information.
                If Rng Is Nothing Then Response = MsgBox("Do You Want To Add Standard?", vbYesNo, "Add Standard")
                    
                    If Response = vbYes Then
                    Standard = InputBox("Enter Standard ID.", "MPD Number")
                    With Sheets("StandardTable")
                    NextRow = .Range("B" & Rows.Count).End(xlUp).row + 1
                    .Range("C" & NextRow) = Standard
                End With
                    Description = InputBox("Enter Standard Description.", "Description")
                    With Sheets("StandardTable")
                    NextRow = .Range("B" & Rows.Count).End(xlUp).row + 1
                    .Range("D" & NextRow) = Description
                End With
                    ID = InputBox("Scan RFID Tag Now.", "Standards RFID Tag")
                    With Sheets("StandardTable")
                    NextRow = .Range("B" & Rows.Count).End(xlUp).row + 1
                    .Range("B" & NextRow) = ID
                End With
                    MsgBox "Scan Standard RFID Again", vbOKOnly
                    UserForm1.Show
                End If
                
                    If Response = vbNo Then
                    MsgBox "Standard Not Found"
                End If
              End With
        'If standard is checked in and row complete then following code applies
        With ws
        irow = ws.Cells.Find(What:="*", SearchOrder:=xlRows, _
        SearchDirection:=xlPrevious, LookIn:=xlValues).row
        On Error Resume Next
                          
        ws.Cells(irow, 1).Value = Application.Index(Range("C2:C500"), Application.Match(Range("A1").Value, Range("B2:B500"), 0))
        ws.Cells(irow, 2).Value = Application.Index(Range("D2:D500"), Application.Match(Range("A1").Value, Range("B2:B500"), 0))
        On Error GoTo 0
        
        
        FindStringID = ws.Cells(irow, 1).Value
            If Trim(FindStringID) <> "" Then
            With Sheets("Report").Range("A2:A500")
            Set rng1 = .Find(What:=FindStringID, _
                After:=.Cells(.Cells.Count), _
                LookIn:=xlValues, _
                LookAt:=xlWhole, _
                SearchOrder:=xlByRows, _
                SearchDirection:=xlNext, _
                MatchCase:=False)
           End With
           End If
           
        If rng1 = 0 & ws.Range("F" & irow) = 1 Then
            irow = ws.Cells.Find(What:="*", SearchOrder:=xlRows, _
            SearchDirection:=xlPrevious, LookIn:=xlValues).row + 0
            ws.Range("A" & irow) = ws.Cells(irow, 1).Value
            ws.Range("B" & irow) = ws.Cells(irow, 2).Value
            ws.Range("E" & irow) = now()
            ws.Range("E" & irow).NumberFormat = "mm/dd/yyyy hh:mm:ss AM/PM"
 
        'If standard is checked out but not in then following code applies.
        Else
            If rng1 = 1 & ws.Range("F" & irow) = 0 Then
            ws.Range("F" & irow) = now()
            ws.Range("F" & irow).NumberFormat = "mm/dd/yyyy hh:mm:ss AM/PM"
        'Replace with code to populate checked in cloumn (F) on active row and overwrite associate name column (D)
    End If
End If
     
         End With
   
            With Sheets("StandardTable").Range("A1")
                .ClearContents
                 UserForm1.Show
            End With
                          
            With Application
                'Sheets("Report").Save
                .EnableEvents = True
                .ScreenUpdating = True
End With
End Sub
 

Excel Facts

VLOOKUP to Left?
Use =VLOOKUP(A2,CHOOSE({1,2},$Z$1:$Z$99,$Y$1:$Y$99),2,False) to lookup Y values to left of Z values.
Hello VBA Gurus, Update to my original post. I have managed to make majority of my code work. with lots of changes. One small issue I cant seem to figure out is still the ElseIf portion. I have 3 things in column/row that need to be >1 or true else next. keep getting a runtime error 13 type mismatch. Not sure how to make this work.

Code:
        With ws
        irow = ws.Cells.Find(What:="*", SearchOrder:=xlRows, _
       SearchDirection:=xlPrevious, LookIn:=xlValues).row + 0
'        On Error Resume Next
        If rng1 > 1 And ws.Range("E" & irow) = 0 Then
            irow = ws.Cells.Find(What:="*", SearchOrder:=xlRows, _
            SearchDirection:=xlPrevious, LookIn:=xlValues).row + 1
             ws.Range("A" & irow) = Sheet3.StandardIDPlaceholder.Value
             ws.Range("B" & irow) = Sheet3.StandardDescPlaceholder.Value
             ws.Range("D" & irow) = Sheet2.AssociateNamePlaceholder.Value
             ws.Range("E" & irow) = now()
             ws.Range("E" & irow).NumberFormat = "mm/dd/yyyy hh:mm:ss AM/PM"
             Sheet3.StandardIDPlaceholder.Value = "" 'Clears the textbox
             Sheet3.StandardDescPlaceholder.Value = "" 'Clears the textbox
             Sheet2.AssociateNamePlaceholder.Value = "" 'Clears the textbox
        'If standard is checked out but not in then following code applies.
         
        
       
        ElseIf irow = ws.Cells.Find(What:="*", SearchOrder:=xlRows, _
        SearchDirection:=xlPrevious, LookIn:=xlValues).row + 0 Then
'        On Error Resume Next
        [COLOR=#FF0000] If rng1 > 1 And ws.Range("E" & irow) > 1 And ("F" & irow) > 1 Then[/COLOR]
            irow = ws.Cells.Find(What:="*", SearchOrder:=xlRows, _
            SearchDirection:=xlPrevious, LookIn:=xlValues).row + 1
             ws.Range("A" & irow) = Sheet3.StandardIDPlaceholder.Value
             ws.Range("B" & irow) = Sheet3.StandardDescPlaceholder.Value
             ws.Range("D" & irow) = Sheet2.AssociateNamePlaceholder.Value
             ws.Range("E" & irow) = now()
             ws.Range("E" & irow).NumberFormat = "mm/dd/yyyy hh:mm:ss AM/PM"
             Sheet3.StandardIDPlaceholder.Value = "" 'Clears the textbox
             Sheet3.StandardDescPlaceholder.Value = "" 'Clears the textbox
             Sheet2.AssociateNamePlaceholder.Value = "" 'Clears the textbox
             
             
        Else
         
        irow1 = ws.Cells.Find(What:=rng1, SearchOrder:=xlRows, _
        SearchDirection:=xlPrevious, LookIn:=xlValues).row + 0
        If rng1 > 1 And ws.Range("E" & irow1) > 0 Then
            ws.Range("F" & irow1) = now()
            ws.Range("F" & irow1).NumberFormat = "mm/dd/yyyy hh:mm:ss AM/PM"
            Sheet3.StandardIDPlaceholder.Value = "" 'Clears the textbox
            Sheet3.StandardDescPlaceholder.Value = "" 'Clears the textbox
            ws.Range("D" & irow1) = Sheet2.AssociateNamePlaceholder.Value
        'Replace with code to populate checked in cloumn (F) on active row and overwrite associate name column (D)
     End If
End If
End If
            With Sheets("StandardTable").Range("A1")
                .ClearContents
                 UserForm1.Show
            End With
                          
            With Application
                'Sheets("Report").Save
                .EnableEvents = True
                .ScreenUpdating = True
End With
End With
End With
 
Upvote 0

Forum statistics

Threads
1,223,270
Messages
6,171,103
Members
452,379
Latest member
IainTru

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top