Appendix Thread. ( Codes for other Threads, etc.) Event Coding Drpdown Data validation

**DocAElstein** · 03-03-2020, 10:04 PM

In support of this Post
http://www.excelfox.com/forum/showth...ge19#post12364

Code:

Sub Compare_drivers_In_DoubleDriver() ' http://www.excelfox.com/forum/showthread.php/2408-Windows-10-and-Office-Excel/page19#post12364
Rem 0
    If ActiveSheet.Name <> "drivers" Then ' This macro was intended to be run from  drivers  to look for things from it in  DoubleDriver
     MsgBox prompt:="Oops": Exit Sub                               '      **the selection should be in drivers
    Else
    End If
Rem 1 Worksheets info
Dim WsDD As Worksheet, WsDrs As Worksheet
 Set WsDD = Worksheets("DDAllBefore"): Set WsDrs = Worksheets("drivers")

Rem 2 Looking at each cell in the selection
' Random number between 3 and 56 to get color index for any matching file names (1 is black, 2 is white , up to 56 is other colors:  3 to 56   is like  (0 to 53)+3  Rnd gives like  0-.99999  so (Int(Rnd*54))+3  is what we want
Dim ClrIdx As Long
 Randomize: Let ClrIdx = (Int(Rnd * 54)) + 3

Dim SrchForCel As Range
    For Each SrchForCel In Selection ' Take each cell in selected range, **the selection should be in drivers
    Dim CelVl As String: Let CelVl = SrchForCel.Value
        If CelVl <> "" And InStr(4, CelVl, ".", vbBinaryCompare) > 1 Then      '                          And Left(CelVl, 3) = "C:\" And InStr(4, CelVl, ".", vbBinaryCompare) > 1 Then ' use some criteria to check we have a file path
        Dim FileNmeSrchFor As String
         Let FileNmeSrchFor = Replace(CelVl, ".mui", "", 1, 1, vbBinaryCompare)                                              '   Let FileNmeSrchFor = Right(CelVl, (Len(CelVl)) - (InStrRev(CelVl, "\", -1, vbBinaryCompare))) ' Determine the file name as that looking from the right as many characters as (the total character number) - (the position looking from the right of a "\")  ---   the characters count left over after the subtraction is equal to the character length of the file name
        Rem 3 We now should have a file name, so we look for it in worksheet  DDAllBefore
        Dim SrchRng As Range: Set SrchRng = Application.Range("=DDAllBefore!D5:DDAllBefore!G670")    '
        Dim FndCel As Range: Set FndCel = SrchRng.Find(what:=FileNmeSrchFor, After:=Application.Range("=DDAllBefore!D5"), LookAt:=xlPart, searchorder:=xlNext, MatchCase:=False) '
            If Not FndCel Is Nothing Then ' the range is set, so the file string has been found in a cell in  DDAllBefore
            Rem 4 we have two matching cells
             'Debug.Print FndCel.Value
            '4b) color matching file names in each worksheet, we do the unecerssary activating and selecting so we can see what is going in
             WsDrs.Activate: SrchForCel.Select ' This worksheet will be colured
             Application.Wait (Now + TimeValue("00:00:01"))
                   'Let SrchForCel.Characters(((InStrRev(CelVl, "\", -1, vbBinaryCompare)) + 1), (Len(CelVl)) - (InStrRev(CelVl, "\", -1, vbBinaryCompare))).Font.ColorIndex = ClrIdx
             Let SrchForCel.Font.ColorIndex = ClrIdx
             
             WsDD.Activate: FndCel.Select ' the other workseet, that being looked in for the file
             Application.Wait (Now + TimeValue("00:00:02"))
             Let FndCel.Font.ColorIndex = ClrIdx
            Else ' No match was found - the thing in the cell in
            End If
        Else ' case no file path string in cell
        End If
    Next SrchForCel
End Sub