A strange problem in excel macro

[kashif.special2005]

Hi,

I have an Excel macro workbook, and through macro it is opening another excel macro file, and after open the excel file, my macro got disable, and when I run this macro from code window through F5, it is giving me a message that enable or disable the macro and when I click on enable macro it runs fine, but when I run this macro from excel workbook, no message showing and my macro got disable.

Note:- I saw from Option and macro security that radio button macro disable without notification is checked, but my question why it is running from from code window.

Please help me on this, my head is spinning, I spend around hours to search solution for this problem, but I can't

Sub Worst_cell_3G()


    Dim wkb1, wkb2, wkb3, wkbthis, wkbfinal As Workbook
    Dim foldpath, filename, dd, fltval, char, wkb2name, wkb3name As String
    Dim csv1, csv2, csv3 As String
    Dim date1 As Date
    Dim skey, kpi As String
    Dim i, j, X, Y, p, q As Long
    Dim col1, col3 As Variant
    Dim arr() As Variant
    Dim col2() As Variant
    
    Dim rngInputDetails As Range, rngSheetName As Range, rngColNameToFind As Range, StrFolderPath As String
    
    Dim StrVlookupColName As String, StrDateColName As String, StrSheetName As String, StrColNameToFind As String
    
    Dim RngTemp As Range, RngTemp1 As Range
    
    Dim VarResult As Variant, VarTemp As Variant
    
    Dim Int_i As Integer
    Dim LngCount As Long
    Dim WsTemp As Worksheet
    Dim StartTime2 As Date
    


    Set rngInputDetails = ThisWorkbook.Names("FilePath").RefersToRange
    Set rngSheetName = ThisWorkbook.Names("SheetsToUpdate").RefersToRange
    
    Set wkbthis = ThisWorkbook
    StrFolderPath = wkbthis.path
    wkbthis.Activate
    ''''''''''''''''''''''''''''''''''''''
    'Start Checking File Existance
    For i = 1 To rngInputDetails.Rows.Count
        If FileFolderExists(rngInputDetails.Item(i, 1), "File") = False Then
            MsgBox "The file '" & rngInputDetails.Item(i, 1) & "' does not exists at the location, please check the file location and try again.", vbCritical + vbOKOnly, "Error"
            Exit Sub
        End If
    Next i
    'End Checking File Existance


    Application.ScreenUpdating = True
    Application.EnableEvents = False
    Application.DisplayAlerts = False
    Application.Calculation = xlCalculationAutomatic
    
    mainfile = rngInputDetails.Item(1, 1)
    
    ans = InputBox("Please Enter no. of day you want to update")


    StartTime2 = Now


    Set wkbmain = Workbooks.Open(mainfile)
    
    Set WsTemp = Worksheets.Add
    
    For aa = 1 To ans
    
        wkbthis.Activate


            csv = rngInputDetails.Item(2, 1)
            StrVlookupColName = rngInputDetails.Item(2, 2)
            StrDateColName = rngInputDetails.Item(2, 3)
            
            Set wkb1 = Workbooks.Open(csv)
            


                lcwbbh = Cells.Find(what:="*", after:=[A1], searchorder:=xlByColumns, searchdirection:=xlPrevious).Column
                shtname = ActiveSheet.Name


                ref1 = findme(StrVlookupColName, wkb1, 1)
                
                If ref1 = 0 Then
                    MsgBox "The column '" & StrVlookupColName & "' is not found in the file '" & wkb1.Name & "' please check the file or check the name in the cell " & rngInputDetails.Item(2, 2).Address & " in the Setting Sheet and try again", vbCritical + vbOKOnly, "Error"
                    wkbmain.Close False
                    wkbthis.Activate
                    Exit Sub
                End If
                
                ref1chr = Col_Letter(ref1)
                lcwbbhchr = Col_Letter(lcwbbh)


                dtpos = findme(StrDateColName, wkb1, 1)


                If dtpos = 0 Then
                    MsgBox "The column '" & StrDateColName & "' is not found in the file '" & wkb1.Name & "' please check the file or check the name in the cell " & rngInputDetails.Item(2, 3).Address & " in the Setting Sheet", vbCritical + vbOKOnly, "Error"
                    wkbmain.Close False
                    wkbthis.Activate
                    Exit Sub
                End If


                dt = Cells(3, dtpos)
                


                For i = 1 To rngSheetName.Rows.Count
                    StrSheetName = rngSheetName.Item(i, 1)
                    StrColNameToFind = rngSheetName.Item(i, 2)


                    ref2 = findme(StrColNameToFind, wkb1, 1)


                    If ref2 = 0 Then
                        MsgBox "The column '" & StrColNameToFind & "' is not found in the file '" & wkb1.Name & "' please check the file or check the name in the cell " & rngSheetName.Item(i, 2).Address & " in the Setting Sheet", vbCritical + vbOKOnly, "Error"
                        wkbmain.Close False
                        wkbthis.Activate
                        Exit Sub
                    End If


                    wkbmain.Activate


                    Sheets(StrSheetName).Select
                    
                    If Sheets(StrSheetName).FilterMode = True Then
                        Range("A1").AutoFilter
                    End If
                                
                    lrw = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
                    lcw = ActiveSheet.Cells.Find(what:="*", after:=[A1], searchorder:=xlByColumns, searchdirection:=xlPrevious).Column
                    
                    With WsTemp
                        .Cells.ClearContents
                        .Range(.Cells(5, 1), .Cells(lrw, 37)).Value = Range(Cells(5, 1), Cells(lrw, 37)).Value
                    End With
                    
                    WsTemp.Activate
                    
                    Range(Cells(5, 7), Cells(lrw, 36)).Value = Range(Cells(5, 8), Cells(lrw, 37)).Value


                    Cells(5, 37) = dt


                    Set RngTemp = Range(Cells(6, 37), Cells(lrw, 37))
                    RngTemp.Formula = "=VLOOKUP(A6,'" & wkb1.Name & "'!$" & ref1chr & ":$" & lcwbbhchr & "," & ref2 - ref1 + 1 & ",0)"
                    RngTemp.Value = RngTemp.Value


                    
                    'Start Replacing Errors
                    If rngSheetName.Item(i, 6) = "Yes" Then
                        If InStr(1, rngSheetName.Item(i, 4), ",") > 0 Then
                            VarTemp = Split(rngSheetName.Item(i, 4), ",")
                            
                            For Int_i = LBound(VarTemp) To UBound(VarTemp)
                                If UCase(VarTemp(Int_i)) = "ERROR" Then
                                    Call ReplaceErrorsCondition(RngTemp, rngSheetName.Item(i, 5))
                                Else
                                    Call ReplaceWithCondition(RngTemp, VarTemp(Int_i), rngSheetName.Item(i, 5))
                                End If
                            Next Int_i
                        Else
                            If UCase(rngSheetName.Item(i, 4)) = "ERROR" Then
                                Call ReplaceErrorsCondition(RngTemp, rngSheetName.Item(i, 5))
                            Else
                                Call ReplaceWithCondition(RngTemp, VarTemp(Int_i), rngSheetName.Item(i, 5))
                            End If
                        End If
                    End If
                    'End Replacing Errors
                    
                    Sheets(StrSheetName).Activate
                    
                    With WsTemp
                        Range(Cells(5, 7), Cells(lrw, 37)).Value = .Range(.Cells(5, 7), .Cells(lrw, 37)).Value
                    End With
                    
                Next i
            
            wkb1.Close


            csv = rngInputDetails.Item(3, 1)




            For i = 1 To rngSheetName.Rows.Count
                If UCase(rngSheetName.Item(i, 3)) = "OTHER" Then
                    StrSheetName = rngSheetName.Item(i, 1)
                    StrColNameToFind = rngSheetName.Item(i, 2)


                    StrVlookupColName = rngInputDetails.Item(3, 2)
                    StrDateColName = rngInputDetails.Item(3, 3)
                    
                    Sheets(StrSheetName).Activate
                    Set RngTemp = Range(Cells(6, 37), Cells(lrw, 37))
                    LngCount = Application.CountIf(RngTemp, "0")
                    
                    If LngCount > 0 Then
                        Set wkb1 = Workbooks.Open(csv)
                        lcwbbh = Cells.Find(what:="*", after:=[A1], searchorder:=xlByColumns, searchdirection:=xlPrevious).Column


                        shtname = ActiveSheet.Name
                        ref1 = findme(StrVlookupColName, wkb1, 1)
                        
                        If ref1 = 0 Then
                            MsgBox "The column '" & StrVlookupColName & "' is not found in the file '" & wkb1.Name & "' please check the file or check the name in the cell " & rngInputDetails.Item(3, 2).Address & " in the Setting Sheet and try again", vbCritical + vbOKOnly, "Error"
                            wkbmain.Close False
                            wkbthis.Activate
                            Exit Sub
                        End If


                        dtpos = findme(StrDateColName, wkb1, 1)
                        ref2 = findme(StrColNameToFind, wkb1, 1)


                        If dtpos = 0 Then
                            MsgBox "The column '" & StrDateColName & "' is not found in the file '" & wkb1.Name & "' please check the file or check the name in the cell " & rngInputDetails.Item(3, 3).Address & " in the Setting Sheet", vbCritical + vbOKOnly, "Error"
                            wkbmain.Close False
                            wkbthis.Activate
                            Exit Sub
                        End If


                        wkbmain.Activate


                        Sheets(StrSheetName).Select
                        
                        If Sheets(StrSheetName).FilterMode = True Then
                            Range("A1").AutoFilter
                        End If
                        
                        With WsTemp
                            .Cells.ClearContents
                            .Range(.Cells(5, 1), .Cells(lrw, 37)).Value = Range(Cells(5, 1), Cells(lrw, 37)).Value
                            Set RngTemp = .Range(.Cells(6, 37), .Cells(lrw, 37))
                        End With
                        
                        WsTemp.Activate
                        
                        Call ReplaceWithCondition(RngTemp, 0, "")
                        Call ReplaceWithCondition(RngTemp, "", "$$$")
                        Call ReplaceWithCondition(RngTemp, "$$$", "")
                        
                        Set RngTemp1 = RngTemp.SpecialCells(xlCellTypeBlanks)
                        
                        RngTemp1.FormulaR1C1 = "=VLOOKUP(RC1,'" & wkb1.Name & "'!C" & ref1 & ":C" & lcwbbh & "," & ref2 - ref1 + 1 & ",0)"
                        RngTemp.Value = RngTemp.Value
                        
                        Call ReplaceErrorsCondition(RngTemp, 0)
                        
                        Sheets(StrSheetName).Activate
                        
                        With WsTemp
                            Range(Cells(5, 37), Cells(lrw, 37)).Value = .Range(.Cells(5, 37), .Cells(lrw, 37)).Value
                        End With
                    End If
                End If
            Next i
            
            If LngCount > 0 Then
                wkb1.Close False
            End If
            
            On Error Resume Next
            WsTemp.Delete
            On Error GoTo 0
    Next aa
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    
    wkbmain.Activate
    wkbmain.SaveAs filename:=StrFolderPath & "\" & rngInputDetails.Item(1, 1).Offset(, -1).Value & "_" & Format(dt, "ddmmyyyy") & ".xlsb", FileFormat:=50
    wkbmain.Close True
    wkbthis.Activate
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    
    Sheets("Click To Run").Select
    Range("A1").Select
    ActiveWorkbook.Save
    
    MsgBox " Done ! HV A NICE DAY, Thanks" & vbCrLf & vbTab & Format(Now - StartTime2, "hh:mm:ss")
    
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.DisplayAlerts = True


End Sub

Thanks
Kashif

 

[RoryA]

Try adding:

application.automationsecurity = msoAutomationSecurityLow

at the start of the code and then reset it at the end using:

application.automationsecurity = msoAutomationSecurityByUI

 

[kashif.special2005]

Hi RoryA,

Thank you so much for your time, it is working like a fly, I have no special word to describe for you kind help, God bless you and many many thanks for your help.

Thanks
Kashif