Combi Box disappearing from the screen.

[LutonBarry]

Folks I hope can help and at the same time give you a giggle at my attempts at coding. I have a Project that runs a few subs. In two of then a combi box asks the user to open a particualr report and the first one in SUB Import () works fine it appears on the screen and stays there untill the user selects Yes or No. The second Combi box in Sub PrepareAllSheetsImport() quickly flashes onto the screen and disappears before a Yes/No selection. Any ideas I've run it without any Application.screenUpdating and Displayalerts but they have no effect.
Apologies for the length of code but I thought it useful to include all the events between the two Combi Boxes.




CompleteRtssReportJob()
' CompleteJob Macro

CleanUp
Import
FilterRTSS
DeleteColumns
WrkGrpShortNameAllCalls
PrepareExportCraigo
PrepareAllSheetImport

Private Sub CleanUp()
' Cleans theworkbook of data from previous days activity.

Dim arr, a
Dim LR As Long
arr =Array("Import", "Open", "Closed","New", "RTSS", "Yesterday")
For Each a In arr
With Sheets(a)
LR = .Cells.Find("*", After:=.Cells(1, 1),SearchDirection:=xlPrevious).Row
.Rows("2:" & LR).Delete
End With
Next
Sheets("Today").Select
Cells.FormatConditions.Delete
Sheets("Yesterday").Select
Cells.FormatConditions.Delete
Sheets("Import").Select
Cells.FormatConditions.Delete
Sheets("Open").Select
Cells.FormatConditions.Delete
Sheets("Closed").Select
Cells.FormatConditions.Delete
Sheets("New").Select
Cells.FormatConditions.Delete
Application.DisplayAlerts = False
Sheets("Today").Select
Rows("2:2").Select
Range(Selection,Selection.End(xlDown)).Delete Shift:=xlUp
Rows("1:1").Select
Selection.Copy
Sheets(Array("Import", "Yesterday", "Open","Closed", "New")).Select
Sheets("Yesterday").Activate
Range("A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Sheets(Array("All", "RAWData")).Delete
Application.DisplayAlerts = True

End Sub



Private Sub Import()
'
' Import Macro
'

'

Dim myCheck AsInteger
myCheck =MsgBox("Brought to you courtesy of the Luton Outlaws. Locate and opentoday's Dashboard Report. Continue?", vbYesNo)
Dim myWorkbook AsWorkbook
myFile =Application.GetOpenFilename()
Workbooks.OpenFilename:=myFile
Set myWorkbook =ActiveWorkbook
Application.Calculation = xlAutomatic
Selection.AutoFilter
Application.DisplayAlerts = False
Sheets("RawData").CopyBefore:=Workbooks("RTSS Reporting.xlsm").Sheets _
(1)
myWorkbook.CloseSaveChanges:=False
Application.DisplayAlerts = True
Application.ScreenUpdating = False

End Sub


Private Sub FilterRTSS()
'
' FilterIngrid Macro
'
' Filters out unwanted data to leaveIgrid's data.
'
Sheets("RawData").Select
Application.DisplayAlerts = False
On Error ResumeNext
Selection.AutoFilter
Application.DisplayAlerts = True
Rows("1:1").Select
Selection.AutoFilter
ActiveSheet.Range("$A$1:$AH$1797").AutoFilter Field:=3,Criteria1:="=RTSS*" _
, Operator:=xlAnd, Criteria2:="<>*-*"
ActiveSheet.Range("$A$1:$AH$1707").AutoFilter Field:=11, Criteria1:=_
"<>*audit*", Operator:=xlAnd
Cells.Select
Range("C1").Activate
Selection.Copy
Sheets("RTSS").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False



End Sub

Private Sub DeleteColumns()
'
' DeleteColumns Macro
'

'
Sheets("RTSS").Select
Range("A1").Select
Selection.CurrentRegion.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("B:B,D:H,J:J,L:T,W:AM").Delete Shift:=x1ToLeft
Range("A1").Select


End Sub

Private Sub WrkGrpShortName()
'
' WrkGrpShortName Macro
'
' Edits Workgroup names to shorttext
'

Sheets("RTSS").Select
Columns("C:C").InsertShift:=xlToLeft, CopyOrigin:=xlFormatFromLeftOrA
Range("C1").Select
ActiveCell.FormulaR1C1 = "To Workgroup"
Columns("D:D").Insert Shift:=xlToRight,CopyOrigin:=xlFormatFromLeftOrAbove
Range("C2").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-1],'Look upsheet'!C[-2]:C[-1],2,FALSE)"
Range("C3").Select
Selection.CurrentRegion.SpecialCells(xlCellTypeBlanks).Select
Selection.FormulaR1C1 = "=R[-1]C"
Range("C2").Select
Range(Selection,Selection.End(xlDown)).Select
Selection.FillDown
Columns("C:C").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("B:B").Delete Shift:=xlToLeft
Columns("C:C").Delete Shift:=xlToLeft
Cells.Select
Cells.EntireColumn.Autofit
Range("A1").Select


End Sub

Private Sub AllCalls()
'
' AllCalls Macro
'

'
Sheets("RTSS").Select
Selection.CurrentRegion.Select
Selection.Copy
Sheets("Import").Select
Range("B2").Select
ActiveSheet.Paste
Rows("2:2").Select
Selection.DeleteShift:=xlUp
Range("A2").Select

End Sub

Private Sub PrepareExportCraigo()
'
' PrepareExportCraigo Macro
'

'
Columns("C:C").Insert Shift:=xlToRight,CopyOrigin:=xlFormatFromLeftOrAbove
Range("C1").Select
ActiveCell.FormulaR1C1 = "Location"
WithActiveCell.Characters(Start:=1, Length:=8).Font
.Name = "Calibri"
.FontStyle = "Regular"
.Size = 11
' .Strikethrough = False
'.Superscript = False
' .Subscript = False
' .OutlineFont = False
' .Shadow = False
' .Underline = xlUnderlineStyleNone
'.ThemeColor =xlThemeColorDark1
' .TintAndShade = 0
' .ThemeFont = xlThemeFontMinor
End With
Columns("C:C").EntireColumn.Autofit
Columns("D:D").Insert Shift:=xlToRight,CopyOrigin:=xlFormatFromLeftOrAbove
Range("A2").CurrentRegion.Select
Selection.SpecialCells(xlCellTypeBlanks).Select
Selection.FormulaR1C1= "Today"
WithSelection.Characters(Start:=1, Length:=5).Font
.Name = "Calibri"
.FontStyle = "Regular"
.Size = 11
'.Strikethrough = False
'.Superscript = False
'.Subscript = False
' .OutlineFont = False
'.Shadow = False
'.Underline = xlUnderlineStyleNone
.ThemeColor = 1
'.TintAndShade = 0
'.ThemeFont = xlThemeFontMinor
Columns("D:D").Delete Shift:=xlToLeft
Range("A2").Select

End With


End Sub

Private Sub PrepareAllSheetImport()
'
' PrepareAllSheetImport Macro
'

'
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Dim myCheck AsInteger
myCheck =MsgBox("Locate and open previous days Call Report. Continue?",vbYesNo)
Dim myWorkbook AsWorkbook
myFile =Application.GetOpenFilename()
Workbooks.OpenFilename:=myFile
Set myWorkbook =ActiveWorkbook
Sheets("Open").Select
Selection.AutoFilter
Sheets("Open").Name = "All"
Sheets("All").Select
Sheets("All").Copy Before:=Workbooks("RTSSReporting.xlsm").Sheets("Open")
Application.DisplayAlerts = False
myWorkbook.CloseSaveChanges:=False
Application.DisplayAlerts = True
Application.ScreenUpdating= False
Sheets("ALL").Select
Columns("C:C").Insert Shift:=xlToRight,CopyOrigin:=xlFormatFromLeftOrAbove
Columns("A:A").Delete Shift:=xlToLeft
Columns("A:A").Insert Shift:=xlToRight,CopyOrigin:=xlFormatFromLeftOrAbove
Range("A1").FormulaR1C1 = "Day"
Range("B1").Copy
Range("A1").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range("A2").Select
Selection.CurrentRegion.Select
Selection.SpecialCells(xlCellTypeBlanks).Select
Selection.FormulaR1C1 = "Yesterday"
With Selection.Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
Columns("C:C").Delete Shift:=xlToLeft
End Sub

[Bob Phillips]

I've rewritten it, see if this alters anything.

BTW, why do you aska a question in that procedure, and not even check the response?


Private Sub PrepareAllSheetImport()
Dim myWorkbook AsWorkbook
Dim myCheck As Long
Dim myFile As String
Dim myCheck As Long

myCheck = MsgBox("Locate and open previous days Call Report. Continue?",vbYesNo)
myFile =Application.GetOpenFilename()
If myFile <> "" Then

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Set myWorkbook = Workbooks.Open(Filename:=myFile)
With Sheets("Open")

.AutoFilter
.Name = "All"
End With

Sheets("All").Copy Before:=Workbooks("RTSSReporting.xlsm").Sheets("Open")
myWorkbook.Close SaveChanges:=False
Application.DisplayAlerts = True
Sheets("ALL").Select
Columns("C:C").Insert Shift:=xlToRight,CopyOrigin:=xlFormatFromLeftOrAbove
Columns("A:A").Delete Shift:=xlToLeft
Columns("A:A").Insert Shift:=xlToRight,CopyOrigin:=xlFormatFromLeftOrAbove
Range("A1").value = "Day"
Range("B1").Copy
Range("A1").PasteSpecial Paste:=xlPasteFormats
With Range("A2").CurrentRegion.SpecialCells(xlCellTypeBlanks)
.Value= "Yesterday"
With .Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
End With
Columns("C:C").Delete Shift:=xlToLeft
End If

Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

[LutonBarry]

xld, Thanks for the response I will try this tomorrow at work. The code is not yet completed so I have yet to complete the procedure to check the response, but as it worked OK when asking the question the first time I expected it to the second time. Which got me thinking that the lack of checking the response may well be why the combi box appears and disappears in a flash.

[snb]

Private Sub Import()
if MsgBox("Brought to you courtesy of the Luton Outlaws. Locate and opentoday's Dashboard Report. Continue?", vbYesNo) =vbYes then
with getobject( Application.GetOpenFilename )
. Sheets("RawData").Copy Workbooks("RTSS Reporting.xlsm").Sheets (1)
.Close 0
end with
end if
End Sub

It might be worthwhile to study the fundamentals of VBA first.