srh12
12-16-2016, 02:59 AM
Hi all,
I trying to add dynamic validation lists to my excel workbook sheets using text files, this works fine but I am getting the error 53 and after I close the error pop up the list is added to my cell,
please I need to disable this error please:
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)Dim i As Integeri = ActiveCell.RowIf Sh.Name <> "BatchRun" And Sh.Name <> "Document Control" And Sh.Name <> "TC Summary" And Sh.Name <> "Test Cases" And Sh.Name <> "StaticData" And Sh.Name <> "Screenshot" ThenIf Target = Range("A" & i) Then'Range("A" & i).Cells.ClearContentsscreensApplication.DisplayAlerts = TrueEnd IfIf Target = Range("B" & i) Then 'Range("B" & i).Cells.ClearContentsEnvironment_listEnd IfIf Target = Range("C" & i) Then ' Range("C" & i).Cells.ClearContentsObjects End If If Target = Range("D" & i) Then ' Range("D" & i).Cells.ClearContentsKeywords_list End If End IfEnd Sub
Sub screens()Dim i As Integeri = ActiveCell.RowGetScreenDetail ("**myscreen**")Dim strFilename_screen As String: strFilename_screen = "C:\files_HOK\screen_hierarchy.txt"Dim strFileContent As StringDim intFile As Integer: intFile = FreeFileOpen strFilename_screen For Input As intFileLine Input #intFile, strFileContentClose intFileWith Range("A" & i).Validation.Delete.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _xlBetween, Formula1:=strFileContent.IgnoreBlank = True.InCellDropdown = True.InputTitle = "".ErrorTitle = "".InputMessage = "".ErrorMessage = "".ShowInput = False.ShowError = FalseEnd WithKill strFilename_screenEnd Sub
Sub GetScreenDetail(val)Dim myline As StringSet filesys = CreateObject("Scripting.FileSystemObject")Set filetxt = filesys.OpenTextFile("C:\files_HOK\Hierarchy.txt")Do Until filetxt.AtEndOfStreamIf CStr(filetxt.ReadLIne) = CStr(val) Thenmyline = filetxt.ReadLIneDim fso As ObjectSet fso = CreateObject("Scripting.FileSystemObject")Dim oFile As ObjectSet oFile = fso.CreateTextFile("C:\files_HOK\screen_hierarchy.txt")oFile.WriteLine mylineEnd IfLoopfiletxt.CloseSet filetxt = NothingSet oFile = NothingSet fso = NothingSet fso = NothingEnd Sub
Sub GetobjectDetail(val)Dim myline As StringSet filesys = CreateObject("Scripting.FileSystemObject")Set filetxt = filesys.OpenTextFile("C:\files_HOK\Objects.txt")Do Until filetxt.AtEndOfStreamIf CStr(filetxt.ReadLIne) = CStr(val) Thenmyline = filetxt.ReadLIneDim fso As ObjectSet fso = CreateObject("Scripting.FileSystemObject")Dim oFile As ObjectSet oFile = fso.CreateTextFile("C:\files_HOK\my_object.txt")oFile.WriteLine mylineEnd IfLoopfiletxt.CloseSet filetxt = NothingSet oFile = NothingSet fso = NothingSet fso = NothingEnd Sub
Sub GetkeywordDetail(val)Dim myline As StringSet filesys = CreateObject("Scripting.FileSystemObject")Set filetxt = filesys.OpenTextFile("C:\files_HOK\Keywords.txt")Do Until filetxt.AtEndOfStreamIf CStr(filetxt.ReadLIne) = CStr(val) Thenmyline = filetxt.ReadLIneDim fso As ObjectSet fso = CreateObject("Scripting.FileSystemObject")Dim oFile As ObjectSet oFile = fso.CreateTextFile("C:\files_HOK\my_keyword.txt")oFile.WriteLine mylineEnd IfLoopfiletxt.CloseSet filetxt = NothingSet oFile = NothingSet fso = NothingSet fso = NothingEnd Sub
Sub Environment_list()Dim myline As StringDim myval As StringDim i As Integeri = ActiveCell.RowSet rCell = ActiveSheet.Range("A" & i)myval = "**" & rCell.Value & "**"GetScreenDetail (myval)Dim strFilename_env As String: strFilename_env = "C:\files_HOK\screen_hierarchy.txt"Dim strFileContent As StringDim iFile As Integer: iFile = FreeFileOpen strFilename_env For Input As #iFile Line Input #iFile, strFileContentClose #iFileWith Range("B" & i).Validation.Delete.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _xlBetween, Formula1:=strFileContent.IgnoreBlank = True.InCellDropdown = True.InputTitle = "".ErrorTitle = "".InputMessage = "".ErrorMessage = "".ShowInput = False.ShowError = FalseEnd WithKill strFilename_envEnd Sub
Sub Objects()Dim myline As StringDim myval As StringDim i As Integeri = ActiveCell.RowSet rCell = ActiveSheet.Range("B" & i)myval = "**" & rCell.Value & "**"GetobjectDetail (myval)Dim strFilename_obj As String: strFilename_obj = "C:\files_HOK\my_object.txt"Dim strFileContent As StringDim x As Integer: x = FreeFileOpen strFilename_obj For Input As #xLine Input #x, strFileContentClose #xWith Range("C" & i).Validation.Delete.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _xlBetween, Formula1:=strFileContent.IgnoreBlank = True.InCellDropdown = True.InputTitle = "".ErrorTitle = "".InputMessage = "".ErrorMessage = "".ShowInput = False.ShowError = FalseEnd WithKill strFilename_objEnd Sub
Sub Keywords_list()Dim myline As StringDim myval As StringDim i As Integeri = ActiveCell.RowSet rCell = ActiveSheet.Range("C" & i)Dim mykeyword As Stringmykeyword = Left(rCell.Value, InStr(rCell.Value, "(") - 1)myval = "**" & mykeyword & "**"GetkeywordDetail (myval)Dim strFilename_key As String: strFilename_key = "C:\files_HOK\my_keyword.txt"Dim strFileContent As StringDim y As Integer: y = FreeFileOpen strFilename_key For Input As #yLine Input #y, strFileContentClose #yWith Range("D" & i).Validation.Delete.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _xlBetween, Formula1:=strFileContent.IgnoreBlank = True.InCellDropdown = True.InputTitle = "".ErrorTitle = "".InputMessage = "".ErrorMessage = "".ShowInput = False.ShowError = FalseEnd WithKill strFilename_keyEnd Sub
Any help pleeeeease ?
I trying to add dynamic validation lists to my excel workbook sheets using text files, this works fine but I am getting the error 53 and after I close the error pop up the list is added to my cell,
please I need to disable this error please:
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)Dim i As Integeri = ActiveCell.RowIf Sh.Name <> "BatchRun" And Sh.Name <> "Document Control" And Sh.Name <> "TC Summary" And Sh.Name <> "Test Cases" And Sh.Name <> "StaticData" And Sh.Name <> "Screenshot" ThenIf Target = Range("A" & i) Then'Range("A" & i).Cells.ClearContentsscreensApplication.DisplayAlerts = TrueEnd IfIf Target = Range("B" & i) Then 'Range("B" & i).Cells.ClearContentsEnvironment_listEnd IfIf Target = Range("C" & i) Then ' Range("C" & i).Cells.ClearContentsObjects End If If Target = Range("D" & i) Then ' Range("D" & i).Cells.ClearContentsKeywords_list End If End IfEnd Sub
Sub screens()Dim i As Integeri = ActiveCell.RowGetScreenDetail ("**myscreen**")Dim strFilename_screen As String: strFilename_screen = "C:\files_HOK\screen_hierarchy.txt"Dim strFileContent As StringDim intFile As Integer: intFile = FreeFileOpen strFilename_screen For Input As intFileLine Input #intFile, strFileContentClose intFileWith Range("A" & i).Validation.Delete.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _xlBetween, Formula1:=strFileContent.IgnoreBlank = True.InCellDropdown = True.InputTitle = "".ErrorTitle = "".InputMessage = "".ErrorMessage = "".ShowInput = False.ShowError = FalseEnd WithKill strFilename_screenEnd Sub
Sub GetScreenDetail(val)Dim myline As StringSet filesys = CreateObject("Scripting.FileSystemObject")Set filetxt = filesys.OpenTextFile("C:\files_HOK\Hierarchy.txt")Do Until filetxt.AtEndOfStreamIf CStr(filetxt.ReadLIne) = CStr(val) Thenmyline = filetxt.ReadLIneDim fso As ObjectSet fso = CreateObject("Scripting.FileSystemObject")Dim oFile As ObjectSet oFile = fso.CreateTextFile("C:\files_HOK\screen_hierarchy.txt")oFile.WriteLine mylineEnd IfLoopfiletxt.CloseSet filetxt = NothingSet oFile = NothingSet fso = NothingSet fso = NothingEnd Sub
Sub GetobjectDetail(val)Dim myline As StringSet filesys = CreateObject("Scripting.FileSystemObject")Set filetxt = filesys.OpenTextFile("C:\files_HOK\Objects.txt")Do Until filetxt.AtEndOfStreamIf CStr(filetxt.ReadLIne) = CStr(val) Thenmyline = filetxt.ReadLIneDim fso As ObjectSet fso = CreateObject("Scripting.FileSystemObject")Dim oFile As ObjectSet oFile = fso.CreateTextFile("C:\files_HOK\my_object.txt")oFile.WriteLine mylineEnd IfLoopfiletxt.CloseSet filetxt = NothingSet oFile = NothingSet fso = NothingSet fso = NothingEnd Sub
Sub GetkeywordDetail(val)Dim myline As StringSet filesys = CreateObject("Scripting.FileSystemObject")Set filetxt = filesys.OpenTextFile("C:\files_HOK\Keywords.txt")Do Until filetxt.AtEndOfStreamIf CStr(filetxt.ReadLIne) = CStr(val) Thenmyline = filetxt.ReadLIneDim fso As ObjectSet fso = CreateObject("Scripting.FileSystemObject")Dim oFile As ObjectSet oFile = fso.CreateTextFile("C:\files_HOK\my_keyword.txt")oFile.WriteLine mylineEnd IfLoopfiletxt.CloseSet filetxt = NothingSet oFile = NothingSet fso = NothingSet fso = NothingEnd Sub
Sub Environment_list()Dim myline As StringDim myval As StringDim i As Integeri = ActiveCell.RowSet rCell = ActiveSheet.Range("A" & i)myval = "**" & rCell.Value & "**"GetScreenDetail (myval)Dim strFilename_env As String: strFilename_env = "C:\files_HOK\screen_hierarchy.txt"Dim strFileContent As StringDim iFile As Integer: iFile = FreeFileOpen strFilename_env For Input As #iFile Line Input #iFile, strFileContentClose #iFileWith Range("B" & i).Validation.Delete.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _xlBetween, Formula1:=strFileContent.IgnoreBlank = True.InCellDropdown = True.InputTitle = "".ErrorTitle = "".InputMessage = "".ErrorMessage = "".ShowInput = False.ShowError = FalseEnd WithKill strFilename_envEnd Sub
Sub Objects()Dim myline As StringDim myval As StringDim i As Integeri = ActiveCell.RowSet rCell = ActiveSheet.Range("B" & i)myval = "**" & rCell.Value & "**"GetobjectDetail (myval)Dim strFilename_obj As String: strFilename_obj = "C:\files_HOK\my_object.txt"Dim strFileContent As StringDim x As Integer: x = FreeFileOpen strFilename_obj For Input As #xLine Input #x, strFileContentClose #xWith Range("C" & i).Validation.Delete.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _xlBetween, Formula1:=strFileContent.IgnoreBlank = True.InCellDropdown = True.InputTitle = "".ErrorTitle = "".InputMessage = "".ErrorMessage = "".ShowInput = False.ShowError = FalseEnd WithKill strFilename_objEnd Sub
Sub Keywords_list()Dim myline As StringDim myval As StringDim i As Integeri = ActiveCell.RowSet rCell = ActiveSheet.Range("C" & i)Dim mykeyword As Stringmykeyword = Left(rCell.Value, InStr(rCell.Value, "(") - 1)myval = "**" & mykeyword & "**"GetkeywordDetail (myval)Dim strFilename_key As String: strFilename_key = "C:\files_HOK\my_keyword.txt"Dim strFileContent As StringDim y As Integer: y = FreeFileOpen strFilename_key For Input As #yLine Input #y, strFileContentClose #yWith Range("D" & i).Validation.Delete.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _xlBetween, Formula1:=strFileContent.IgnoreBlank = True.InCellDropdown = True.InputTitle = "".ErrorTitle = "".InputMessage = "".ErrorMessage = "".ShowInput = False.ShowError = FalseEnd WithKill strFilename_keyEnd Sub
Any help pleeeeease ?