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

**DocAElstein** · 03-03-2020, 01:10 AM

In support of this Thread: http://www.excelfox.com/forum/showth...2530#post12530

Originally Posted by fixer

..save and close the sample2.xls and sample3.xlsb...

To help get syntax we can use a macro recording…

Macro recording for simple save..

Open sample2.xls
Open sample3.xlsb
Open sample1.xlsm

StartMacroRecording.JPG : https://imgur.com/4KAUJGa
NameRecordingMacro.JPG : https://imgur.com/AP6qdY2

Save sample2 xls.jpg : https://imgur.com/JhQEZzv
Close sample2 xls.JPG : https://imgur.com/aEKtCTN

Save sample3 xlsb.JPG : https://imgur.com/ontjd4z
Close sample3 xlsb.JPG : https://imgur.com/kbDEhfm

Stop Recording Macro.JPG : https://imgur.com/loqaTkc

Recorded Macro.JPG : https://imgur.com/SFY0jcW

Code:

Sub AvASave()
'
' AvASave Makro
'

'
    Windows("sample2.xls").Activate
    ActiveWorkbook.Save
    ActiveWorkbook.Close
    Windows("sample3.xlsb").Activate
    ActiveWorkbook.Save
    ActiveWorkbook.Close
End Sub

Macro recording for Save As..

Open sample2.xls
Open sample3.xlsb
Open sample1.xlsm

StartMacroRecording.JPG : https://imgur.com/4KAUJGa
NameRecordingMacro2.JPG : https://imgur.com/mDEneOt

SaveAs sample2 xls.jpg : https://imgur.com/xjqgPRO , https://imgur.com/UpT3pAB
Close sample2 xls.JPG : https://imgur.com/aEKtCTN

SaveAs sample3 xlsb.JPG : https://imgur.com/QF5yo6L , https://imgur.com/hgyV1Tm
Close sample3 xlsb.JPG : https://imgur.com/kbDEhfm

Stop Recording Macro.JPG : https://imgur.com/loqaTkc

Recorded Macro2.JPG : https://imgur.com/zHm6DY2

Code:

Sub AvASaveAs()
'
' AvASaveAs Makro
'
    Windows("sample2.xls").Activate
    ActiveWorkbook.SaveAs Filename:= _
        "F:\Excel0202015Jan2016\ExcelFox\vixer\sample2.xls", FileFormat:=xlExcel8, _
        Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
        CreateBackup:=False
    ActiveWorkbook.Close
    Windows("sample3.xlsb").Activate
    ActiveWorkbook.SaveAs Filename:= _
        "F:\Excel0202015Jan2016\ExcelFox\vixer\sample3.xlsb", FileFormat:=xlExcel12, _
        CreateBackup:=False
    ActiveWorkbook.Close
End Sub

**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