Matching/Comparing Data between Sheets According to Date

[LA7ERALUS]

I have the following macro (that works):

Private Declare Function PlaySound Lib "winmm.dll" _
  Alias "PlaySoundA" (ByVal lpszName As String, _
  ByVal hModule As Long, ByVal dwFlags As Long) As Long


    Const SND_SYNC = &H0
    Const SND_ASYNC = &H1
    Const SND_FILENAME = &H20000


Private Sub Worksheet_Change(ByVal Target As Range)
    Dim KeyCells As Range
    Dim NewCodeToFind As String
    
    
    Dim RowNumber As Integer
    


    Set KeyCells = Range("A:A")
    
 
    
    
    If Not Application.Intersect(KeyCells, Range(Target.Address)) _
           Is Nothing Then
        
        Range("A1").Select
        Selection.End(xlDown).Select
        NewCodeToFind = Selection.Value
        
        
        
        RowNumber = 2
        
        Do Until IsEmpty(Worksheets(2).Cells(RowNumber, 1))
            
            If Worksheets(2).Cells(RowNumber, 1) = NewCodeToFind Then
              
                If Not Worksheets(2).Cells(RowNumber, 2) = 1 Then
                    Call PlaySound("c:\windows\media\tada.wav", _
                    0, SND_ASYNC Or SND_FILENAME)
                    MSG1 = MsgBox(NewCodeToFind & "  FOUND?", vbYesNo, "***FOUND***")
                    If MSG1 = vbYes Then
                        
                        Worksheets(2).Cells(RowNumber, 2) = 1
                        Exit Sub
                    Else
                        Worksheets(2).Cells(RowNumber, 2) = 0
                    End If
                End If
            End If
           
            RowNumber = RowNumber + 1
        Loop
      


       
    End If
End Sub

It compares data between sheet 1 and sheet 2, when there is a match a message pops up and a sound plays. However this is only limited to column A on sheet 1 and column A on sheet 2. Each column on sheet 1 represents a specific day, data is inputted into the respective column for the day.

When data is inputted into sheet 2 and it is being matched to data in sheet 1, I want it to match the column that reflects today's date.

I found a macro that selects todays date:

Sub SelectDate()

     Dim fR As Range
     With Me.Range("A1:N1")
          Set fR = .Find(what:=Date, after:=Range("A1"), LookIn:=xlValues, lookat:=xlWhole)
          If Not fR Is Nothing Then fR.Select
     End With

Hope that helps

I basically don't want to make a separate excel document for each day

 

[JLGWhiz]

There is not enough description of what sheet 1 looks like to work with. Which columns contain dates? what type of dates? Day of week, month-year? short date? (format), etc. If you can post a screen shot, or a facimile mock up, it would be helpful. If you don't have the HTML maker down loaded, you can put borders around the cells (Not all, just an example) and copy those right into the thread.

 

[LA7ERALUS]

There is not enough description of what sheet 1 looks like to work with. Which columns contain dates? what type of dates? Day of week, month-year? short date? (format), etc. If you can post a screen shot, or a facimile mock up, it would be helpful. If you don't have the HTML maker down loaded, you can put borders around the cells (Not all, just an example) and copy those right into the thread.

I apologize for the lack of information, here are some screenshots:

Sheet1:

Sheet2:

I fixed the code so it tries to match data that has been inputted in the cells with the heading of the current date, this is my code currently:

Private Declare Function PlaySound Lib "winmm.dll" _  Alias "PlaySoundA" (ByVal lpszName As String, _
  ByVal hModule As Long, ByVal dwFlags As Long) As Long


    Const SND_SYNC = &H0
    Const SND_ASYNC = &H1
    Const SND_FILENAME = &H20000


Private Sub Worksheet_Change(ByVal Target As Range)
    Dim KeyCells As Range
    Dim NewCodeToFind As String
    
    
    Dim RowNumber As Integer
    


    Set KeyCells = Range("A:D")
    
 
    
    
    If Not Application.Intersect(KeyCells, Range(Target.Address)) _
           Is Nothing Then
        
        Range("A1:D1").Find(Date).Select
        Selection.End(xlDown).Select
        NewCodeToFind = Selection.Value
        
        
        
        RowNumber = 2
        
        Do Until IsEmpty(Worksheets(2).Cells(RowNumber, 1))
            
            If Worksheets(2).Cells(RowNumber, 1) = NewCodeToFind Then
              
                If Not Worksheets(2).Cells(RowNumber, 2) = 1 Then
                    Call PlaySound("c:\windows\media\tada.wav", _
                    0, SND_ASYNC Or SND_FILENAME)
                    MSG1 = MsgBox(NewCodeToFind & "  FOUND?", vbYesNo, "***FOUND***")
                    If MSG1 = vbYes Then
                        
                        Worksheets(2).Cells(RowNumber, 2) = 1
                        Exit Sub
                    Else
                        Worksheets(2).Cells(RowNumber, 2) = 0
                    End If
                End If
            End If
           
            RowNumber = RowNumber + 1
        Loop
      


       
    End If
End Sub

However I do have a new problem: If I have multiple "Box to Find" numbers it will match the one that is listed first, quite usually there are multiple numbers that I would need to match. I would like to edit the macro so it tries to match ANY number in column A in sheet 2 to the column in sheet 1 with today's date as the heading. I'm assuming I have set up a range for the section between "RowNumber = 2" and "Loop". I've played around with it a little bit, however I'm new with VBA and I'm not quite sure how to go about it.

 

[JLGWhiz]

This would be my take on multiple matches. You could attach this to a button. Or it could be modified to run on a worksheet event trigger. But since it is checking multiple values, I assumed all the entries would be made first and then the code would run.

Sub multisearch()
Dim sh1 As Worksheet, sh2 As Worksheet, lr As Long, rng As Range, c As Range, fLoc As Range, fRng As Range
Set sh1 = Sheets(1) 'Edit sheet name
Set sh2 = Sheets(2) 'Edit sheet name
lr = sh2.Cells(Rows.Count, 1).End(xlUp).Row
lc = sh1.Cells(1, Columns.Count).End(xlToLeft).Column
Set rng = sh2.Range("A2:A" & lr)
    For Each c In rng
        Set fLoc = sh1.Range("A1", sh1.Cells(1, lc)).Find(Date, , xlValues, xlWhole)
            If Not fLoc Is Nothing Then
                Set fRng = sh1.Columns(fLoc.Column).Find(c.Value, , xlValues, xlWhole)
                    If Not fRng Is Nothing Then
                        Call PlaySound("c:\windows\media\tada.wav", _
                                        0, SND_ASYNC Or SND_FILENAME)
                                MSG1 = MsgBox(c.Value & "  FOUND?", vbYesNo, "***FOUND***")
                                If MSG1 = vbYes Then
                                    Worksheets(2).Cells(RowNumber, 2) = 1
                                    Exit Sub
                                Else
                                    Worksheets(2).Cells(RowNumber, 2) = 0
                                End If
                   End If
            End If
    Next
End Sub

 

[LA7ERALUS]

This would be my take on multiple matches. You could attach this to a button. Or it could be modified to run on a worksheet event trigger. But since it is checking multiple values, I assumed all the entries would be made first and then the code would run.

Sub multisearch()
Dim sh1 As Worksheet, sh2 As Worksheet, lr As Long, rng As Range, c As Range, fLoc As Range, fRng As Range
Set sh1 = Sheets(1) 'Edit sheet name
Set sh2 = Sheets(2) 'Edit sheet name
lr = sh2.Cells(Rows.Count, 1).End(xlUp).Row
lc = sh1.Cells(1, Columns.Count).End(xlToLeft).Column
Set rng = sh2.Range("A2:A" & lr)
    For Each c In rng
        Set fLoc = sh1.Range("A1", sh1.Cells(1, lc)).Find(Date, , xlValues, xlWhole)
            If Not fLoc Is Nothing Then
                Set fRng = sh1.Columns(fLoc.Column).Find(c.Value, , xlValues, xlWhole)
                    If Not fRng Is Nothing Then
                        Call PlaySound("c:\windows\media\tada.wav", _
                                        0, SND_ASYNC Or SND_FILENAME)
                                MSG1 = MsgBox(c.Value & "  FOUND?", vbYesNo, "***FOUND***")
                                If MSG1 = vbYes Then
                                    Worksheets(2).Cells(RowNumber, 2) = 1
                                    Exit Sub
                                Else
                                    Worksheets(2).Cells(RowNumber, 2) = 0
                                End If
                   End If
            End If
    Next
End Sub

Really appreciate your help. Perhaps I'm not giving near as much information as I should be so I'll try my best to explain what is going on and why I need certain functions to exist.

- Boxes are delivered each day and their barcode is scanned and recorded into its designated column in sheet 1.
- Sometimes certain boxes need to be set aside- these boxes are (manually) recorded in column A of sheet 2
- Quite often, a group of boxes will be sent that share the same barcode

*For example, if barcode "12345" wants to be set aside, on June 10, and there are 5 boxes with that barcode (not necessarily being recorded one after the other) I would like to have 5 different notifications for each individual time that "12345" is scanned. I will add that there is absolutely no way of knowing for sure how many boxes share the same barcode.

*If there are 5 different barcodes in sheet 2 column A I want to be able to look for ALL of them in the specified column (for each day) in sheet 1.

- Barcodes that need to be found have potential to update during the day, so I also need for it to be able to search barcodes that have been recorded in the specified column (aka day)

*For example, if I typed in that I want to find box(es) "67890" at 11AM on June 10 I want it to be able to search the June 10 column to see if it has been scanned in before 11AM (which it would notify me if it was) OR if it is scanned after.

 

[JLGWhiz]

The part that is throwing me off is that the event code was being run from sheet 1, which means that it would be triggered by a change somewhere on that sheet, probably scanned in under current date. Thus the End(xlDown) to get the value. Then that is checked against your manual entries on sheet 2, column A. But your description of events indicates that the scanned entries would be made first and then the manual entries would be made to sheet 2. Ergo, my concept of checking from sheet 2 to sheet 1. I suppose it would work either way. If you want to check from sheet 1 to sheet 2 using the Worksheet_Change, you could either use a For Each...Next loop or a Do loop with a FindNext function to walk down the sheet 2, column A entries.

 

[LA7ERALUS]

The part that is throwing me off is that the event code was being run from sheet 1, which means that it would be triggered by a change somewhere on that sheet, probably scanned in under current date. Thus the End(xlDown) to get the value. Then that is checked against your manual entries on sheet 2, column A. But your description of events indicates that the scanned entries would be made first and then the manual entries would be made to sheet 2. Ergo, my concept of checking from sheet 2 to sheet 1. I suppose it would work either way. If you want to check from sheet 1 to sheet 2 using the Worksheet_Change, you could either use a For Each...Next loop or a Do loop with a FindNext function to walk down the sheet 2, column A entries.

Thank you! I will give it a try!