Help with vba if statement

LilStevie

Board Regular
Joined
Nov 13, 2006
Messages
232
I've racked my brains around this one and can't seem to get it to work. I have a input box that prompts the user for a new worksheet name but I need to add an if statement for when the user skips or fails to enter the name. See the full code below. Any help or suggestion would be greatly appreciated.

Here is the bad section with the IF that I tried:

Dim Temp$
Temp = InputBox("Month Year Name of new worksheet (ie Oct06)", "Inputbox")
'If Temp = False Then Sheets("input").Name = "new"
Sheets("input").Name = Temp
Dim TotalSheets As Variant
TotalSheets = Worksheets.Count - 1
Worksheets.Add after:=Worksheets(TotalSheets)
ActiveSheet.Name = "input"


Code:
Sub master()
    
    Application.ScreenUpdating = False
    Application.StatusBar = "     Please be Patient while the Macro Runs!"
    NewFN = Application.GetOpenFilename(FileFilter:="Excel Files (*.txt), *.txt", Title:="Please select a file to import")
    If NewFN = False Then
    ' They pressed Cancel
    MsgBox "Stopping because you did not select a file"
    Exit Sub
    Else
    Workbooks.Open Filename:=NewFN
    End If
    MsgBox "Please wait. . . . .     ", vbInformation, "Macro Running"
    Dim spStatBar As StatusProgress
    Set spStatBar = New StatusProgress
       'Set up all the properties of the progress bar
    With spStatBar
        .Style = Style1
        .Color = NavyBlue
        .BarType = Smooth
        .MaxProgress = 100
                 
        .ProgressShow 'Show the progress bar when necessary
        
        Columns("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, Tab:=True, Other:=True, OtherChar:="^", _
        FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, _
        1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12 _
        , 1), Array(13, 1), Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18, 1), _
        Array(19, 1)), TrailingMinusNumbers:=True
        Columns("O:O").Insert Shift:=xlToRight
        Columns("N:N").TextToColumns Destination:=Range("N1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, Tab:=True, Other:=True, OtherChar:="@", _
        FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
        Columns("S:S").Insert Shift:=xlToRight
        Columns("R:R").TextToColumns Destination:=Range("R1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, Tab:=True, Other:=True, OtherChar:="@", _
        FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
    'update progress bar
    '==============================================================
    .Progress 10
        Columns("A:U").EntireColumn.AutoFit
        Columns("F:G").Cut
        Columns("C:C").Insert Shift:=xlToRight
        Columns("H:I").Cut
        Columns("E:E").Insert Shift:=xlToRight
        Columns("K:L").Cut
        Columns("A:A").Insert Shift:=xlToRight
        Columns("N:O").Cut
        Columns("I:I").Insert Shift:=xlToRight
        Columns("R:S").Cut
        Columns("K:K").Insert Shift:=xlToRight
        Columns("Q:Q").Delete Shift:=xlToLeft
        Columns("R:R").Delete Shift:=xlToLeft
        Columns("P:P").Cut
        Columns("S:S").Insert Shift:=xlToRight
        Columns("C:C").Select
        Selection.Insert Shift:=xlToRight
        Columns("F:F").Insert Shift:=xlToRight
        Columns("I:I").Insert Shift:=xlToRight
        Columns("L:L").Insert Shift:=xlToRight
        Columns("O:O").Insert Shift:=xlToRight
        Columns("R:R").Insert Shift:=xlToRight
        Range("C2:C5000").FormulaR1C1 = "=RC[-2]+RC[-1]"
        Range("C2:C5000").NumberFormat = "m/d/yyyy h:mm"
        Range("C2:C5000") = Range("C2:C5000").Value
        Range("C1").FormulaR1C1 = "ORDER" & Chr(10) & "DATE/TIME"
        Columns("A:B").Delete Shift:=xlToLeft
        Range("D2:d5000").FormulaR1C1 = "=RC[-2]+RC[-1]"
        Range("d2:d5000").NumberFormat = "m/d/yyyy h:mm"
        Range("d2:d5000") = Range("d2:d5000").Value
        Range("D1").FormulaR1C1 = "EXAM" & Chr(10) & "DATE/TIME"
    'update progress bar
    '==============================================================
    .Progress 20
        Columns("B:C").Delete Shift:=xlToLeft
        Range("E2:E5000").FormulaR1C1 = "=RC[-2]+RC[-1]"
        Range("E2:E5000").NumberFormat = "m/d/yyyy h:mm"
        Range("e2:e5000") = Range("e2:e5000").Value
        Columns("C:D").Delete Shift:=xlToLeft
        Range("C1").FormulaR1C1 = "ARRIVAL" & Chr(10) & "DATE/TIME"
        Range("F2:F5000").FormulaR1C1 = "=RC[-2]+RC[-1]"
    Range("F2:F5000").NumberFormat = "m/d/yyyy h:mm"
    Range("F2:F5000") = Range("F2:F5000").Value
    Columns("D:E").Delete Shift:=xlToLeft
    Range("D1").FormulaR1C1 = "DEPART" & Chr(10) & "DATE/TIME"
    Range("G2:G5000").FormulaR1C1 = "=LEFT(RC[-1],LEN(RC[-1])-2)/24+RIGHT(RC[-1],2)/1440"
    Range("G2:G5000").NumberFormat = "h:mm;@"
    Range("g2:G5000") = Range("g2:g5000").Value
    'update progress bar
    '==============================================================
    .Progress 30
    Columns("H:H").Insert Shift:=xlToRight
    Range("H2:h5000").FormulaR1C1 = "=RC[-3]+RC[-1]"
    Range("H2:H5000").NumberFormat = "m/d/yyyy h:mm"
    Range("h2:h5000") = Range("h2:h5000").Value
    Range("H1").FormulaR1C1 = "VERIFIED" & Chr(10) & "DATE/TIME"
    Columns("E:G").Delete Shift:=xlToLeft
    Range("H2:h5000").FormulaR1C1 = "=LEFT(RC[-1],LEN(RC[-1])-2)/24+RIGHT(RC[-1],2)/1440"
    Range("H2:h5000").NumberFormat = "h:mm;@"
    Range("h2:h5000") = Range("h2:h5000").Value
    Columns("I:I").Insert Shift:=xlToRight
    Range("I2:I5000").FormulaR1C1 = "=RC[-3]+RC[-1]"
    Range("I2:I5000").NumberFormat = "m/d/yyyy h:mm"
    Range("I2:I5000") = Range("I2:I5000").Value
    Range("I1").FormulaR1C1 = "COMPLETE" & Chr(10) & "DATE/TIME"
    'update progress bar
    '==============================================================
    .Progress 40
    Columns("F:H").Delete Shift:=xlToLeft
    Columns("G:G").Select
    Selection.Insert Shift:=xlToRight
    Selection.Insert Shift:=xlToRight
    Selection.Insert Shift:=xlToRight
    Columns("E:E").Cut
    Columns("G:G").Insert Shift:=xlToRight
    Range("E1").FormulaR1C1 = "DICTATED" & Chr(10) & "DATE/TIME"
    Range("F1").FormulaR1C1 = "COMPLETE" & Chr(10) & "DATE/TIME"
    Range("G2:G5000").FormulaR1C1 = "=RC[-2]-RC[-4]"
    Range("G2:G5000").NumberFormat = "[h]:mm"
    Range("G1").FormulaR1C1 = "A-B" & Chr(10) & "ELAPSED" & Chr(10) & "TIME"
    Range("H2:H5000").FormulaR1C1 = "=RC[-2]-RC[-3]"
    Range("H2:H5000").NumberFormat = "[h]:mm"
    Range("H1").FormulaR1C1 = "B-C" & Chr(10) & "ELAPSED" & Chr(10) & "TIME"
    Range("I2:I5000").FormulaR1C1 = "=RC[-3]-RC[-6]"
    'update progress bar
    '==============================================================
    .Progress 50
    Range("I2:I5000").NumberFormat = "[h]:mm"
    Range("I1").FormulaR1C1 = "A-C" & Chr(10) & "ELAPSED" & Chr(10) & "TIME"
    Range("G2:G5000") = Range("G2:G5000").Value
    Range("H2:H5000") = Range("H2:hH5000").Value
    Range("I2:I5000") = Range("I2:I5000").Value
    Application.Calculation = xlCalculationManual
    With ActiveSheet
             If .AutoFilterMode = False Then .Cells(1, 1).AutoFilter
                    .Range("A1").AutoFilter Field:=9, Criteria1:="#VALUE!"
                    .Range("A1").CurrentRegion.Offset(1, 0).SpecialCells _
            (xlCellTypeVisible).EntireRow.Delete
            .AutoFilterMode = False
    End With
   'update progress bar
    '==============================================================
    .Progress 60
    With ActiveSheet
             If .AutoFilterMode = False Then .Cells(1, 1).AutoFilter
                    .Range("A1").AutoFilter Field:=8, Criteria1:="#VALUE!"
                    .Range("A1").CurrentRegion.Offset(1, 0).SpecialCells _
            (xlCellTypeVisible).EntireRow.Delete
            .AutoFilterMode = False
    End With
    With ActiveSheet
             If .AutoFilterMode = False Then .Cells(1, 1).AutoFilter
                    .Range("A1").AutoFilter Field:=7, Criteria1:="#VALUE!"
                    .Range("A1").CurrentRegion.Offset(1, 0).SpecialCells _
            (xlCellTypeVisible).EntireRow.Delete
            .AutoFilterMode = False
    End With
    'update progress bar
    '==============================================================
    .Progress 70
        With ActiveSheet
             If .AutoFilterMode = False Then .Cells(1, 1).AutoFilter
                    .Range("A1").AutoFilter Field:=9, Criteria1:="0:00"
                    .Range("A1").CurrentRegion.Offset(1, 0).SpecialCells _
            (xlCellTypeVisible).EntireRow.Delete
            .AutoFilterMode = False
    End With
    With ActiveSheet
             If .AutoFilterMode = False Then .Cells(1, 1).AutoFilter
                    .Range("A1").AutoFilter Field:=4, Criteria1:="1/0/1900 0:00"
                    .Range("D2:D5000").ClearContents
            .AutoFilterMode = False
    End With
    Range("A1:P3976").Sort Key1:=Range("I2"), Order1:=xlDescending, Header:= _
        xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
      Application.Calculation = xlCalculationAutomatic
      Columns("B:B").Delete Shift:=xlToLeft
    Range("B1").FormulaR1C1 = "A" & Chr(10) & "" & Chr(10) & "ARRIVAL" & Chr(10) & "DATE/TIME"
    Range("D1").FormulaR1C1 = "B" & Chr(10) & "" & Chr(10) & "DICTATED" & Chr(10) & "DATE/TIME"
    Range("E1").FormulaR1C1 = "C" & Chr(10) & "" & Chr(10) & "COMPLETE" & Chr(10) & "DATE/TIME"
    Range("I1").FormulaR1C1 = "EXAM #"
    Range("J1").FormulaR1C1 = "EXAM" & Chr(10) & "TYPE"
    Range("K1").FormulaR1C1 = "IMAGING" & Chr(10) & "TYPE"
    Range("L1").FormulaR1C1 = "RAD"
    Range("M1").FormulaR1C1 = "LOCATION"
    Range("N1").FormulaR1C1 = "REQ" & Chr(10) & "HCP"
    Range("O1").FormulaR1C1 = "LOCATION" & Chr(10) & " CODE"
    Range("S13").Select
    ActiveWindow.LargeScroll ToRight:=-1
    Cells.Select
    Selection.Copy
    Windows("MASTER.xls").Activate
    Sheets("input").Select
    Range("D32").Select
    ActiveWindow.ScrollRow = 1
    Cells.Select
    ActiveSheet.Paste
    Range("C9").Select
    Sheets("HEADER FORMULAS").Visible = True
    Sheets("HEADER FORMULAS").Select
    Rows("1:26").Copy
    Sheets("HEADER FORMULAS").Visible = False
    Sheets("input").Select
    Rows("1:1").Insert Shift:=xlDown
    Range("E9").Select
    ActiveWindow.SmallScroll ToRight:=2
    Range("L28").Select
    Application.CutCopyMode = False
    Range("L27:M5000").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _
        "F3:G25"), Unique:=True
    Range("F3:G25").Select
    Selection.Sort Key1:=Range("G3"), Order1:=xlAscending, Key2:=Range("F3") _
        , Order2:=xlAscending, Header:=xlNo, OrderCustom:=1, MatchCase:=False, _
        Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2:= _
        xlSortNormal
    Range("F2:L25").Select
    'update progress bar
    '==============================================================
    .Progress 80
    Selection.AutoFilter
    Selection.AutoFilter Field:=7
    Selection.AutoFilter Field:=1, Criteria1:="="
    Range("F20:L25").Select
    Selection.ClearContents
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Selection.Interior.ColorIndex = xlNone
    Selection.AutoFilter
    Range("F2:L19").Select
    Selection.AutoFilter
    Selection.AutoFilter Field:=1, Criteria1:="RAD"
    Range("F19:L19").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Selection.Interior.ColorIndex = xlNone
    Selection.ClearContents
    Selection.AutoFilter

    'conditional formatting based on physician locations
Dim rnArea As Range
Dim rnCell As Range
Set rnArea = Range("F3:G25")
  For Each rnCell In rnArea
     With rnCell
        If Not IsError(.Value) Then
      Select Case .Value
          Case "GREER,CHARLES F", "PHILLIPS,W EUGENE", "GAGLIONE,JOSEPH I", "DANIELS,ROYDEN E", "CRANNY,JENNIFER R", "GAROVICH,MICHAEL C", "PIASKOWSKI,RONALD A", "GREENSLIT,MARK L", "CUTHBERTSON,RAND J", "DODDS,COLIN A", "DODDS,JANINE M", "DEUSKAR,SUDAN", "SMITH,WILLIAM SEAN", "PUCKETTE,THOMAS C", "MULLANEY,JOSEPH M", "AIR FORCE BASE CLINIC"
          .Interior.ColorIndex = 36
          .Font.Bold = True
          Case "PONCE,RICARDO S", "SHERBERT,T RAY", "LYNCH,GEORGE M", "WALSH,JAMES A", "DANIGELIS,JAMES A", "BEAUFORT NAVAL HOSPITAL"
            .Interior.ColorIndex = 20
            .Font.Bold = True
          Case "HABAKUS,SCOTT J", "WATERFIELD,ROSS T", "LABUSKI,MARK R", "FAGAN,STEVEN J", "CHARLESTON NAVAL HOSPITAL"
            .Interior.ColorIndex = 24
            .Font.Bold = True
          End Select
       End If
   End With
Next
    Range("B28").Select
    Selection.Copy
    Range("A1:D1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Selection.NumberFormat = "mmm yy"
    
    ' ADJUST FORMATTING
        Range("A27:O27").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
    End With
    With Selection.Font
        .Name = "Arial"
        .FontStyle = "Bold"
        .Size = 9
    End With
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
  'update progress bar
    '==============================================================
    .Progress 90
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Interior
        .ColorIndex = 15
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
    End With
    Rows("28:5000").Select
    With Selection.Font
        .Name = "Arial"
        .Size = 7
    End With
    Columns("A:A").ColumnWidth = 14.57
    Columns("B:B").ColumnWidth = 11
    Columns("C:C").ColumnWidth = 11.29
    Columns("D:D").ColumnWidth = 11.43
    Columns("E:E").ColumnWidth = 12.29
    Columns("F:F").ColumnWidth = 8.71
    Columns("G:G").ColumnWidth = 8.71
    Columns("H:H").ColumnWidth = 8.57
    Columns("I:I").ColumnWidth = 7.71
    Columns("J:J").ColumnWidth = 9
    Columns("K:K").ColumnWidth = 9.57
    Columns("L:L").ColumnWidth = 7.14
    Columns("M:M").ColumnWidth = 9.43
    Columns("N:N").ColumnWidth = 9.86
    Columns("O:O").ColumnWidth = 9.57
    
    'insert comments with days
    Range("B6:D9,B13:D16,B20:D23,H3:K23,O5:O14").Select
    Application.Run "MASTER.xls!CommentThem"
    
    'change comment tab color
    Application.Run "MASTER.xls!CoverCommentIndicator"
    
    'Setting printer areas and landscape mode
    ActiveSheet.PageSetup.PrintArea = "$A$1:$Q$24"
    With ActiveSheet.PageSetup
        .CenterHorizontally = True
        .CenterVertically = True
        .Orientation = xlLandscape
        .Draft = False
        .PaperSize = xlPaperLetter
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 1
        .PrintErrors = xlPrintErrorsDisplayed
    End With

        '===========================================
        'problem code to be fixed with bad "if" statement included    
        'Renaming the new sheet and creating a new input worksheet

        Dim Temp$
        Temp = InputBox("Month Year Name of new worksheet (ie Oct06)", "Inputbox")
        'If Temp = False Then Sheets("input").Name = "new"
        Sheets("input").Name = Temp
        Dim TotalSheets As Variant
        TotalSheets = Worksheets.Count - 1
        Worksheets.Add after:=Worksheets(TotalSheets)
        ActiveSheet.Name = "input"
    
         '===========================================

    'update progress bar
    '==============================================================
    .Progress 100
     ' Open print dialog and print sheets
    Dim i As Integer
    Dim TopPos As Integer
    Dim SheetCount As Integer
    Dim PrintDlg As DialogSheet
    Dim CurrentSheet As Worksheet
    Dim CurrentChart As Chart
    Dim StartSheet As String
    Dim cb As CheckBox
    Application.ScreenUpdating = False
     ' Check for protected workbook
    If ActiveWorkbook.ProtectStructure Then
        MsgBox "Workbook is protected.", vbCritical
        Exit Sub
         ' Check for 'non-worksheet'
    ElseIf ActiveSheet.Type <> xlWorksheet Then
        MsgBox "You can only start this from a WorkSheet.", vbCritical
        Exit Sub
    End If
     ' Add a temporary dialog sheet
    Set CurrentSheet = ActiveSheet
    StartSheet = ActiveSheet.Name
    Set PrintDlg = ActiveWorkbook.DialogSheets.Add
    SheetCount = 0
     ' Add the checkboxes
    TopPos = 40
    For i = 1 To ActiveWorkbook.Sheets.Count
        If Left(ActiveWorkbook.Sheets(i).Name, 6) = "Dialog" Then GoTo GetNextSheet
        If ActiveWorkbook.Sheets(i).Type = xlWorksheet Then
            Set CurrentSheet = ActiveWorkbook.Sheets(i)
            GoTo GotWorksheet
        ElseIf ActiveWorkbook.Sheets(i).Type = 3 _
            Or ActiveWorkbook.Sheets(i).Type = 4 Then
                Set CurrentChart = ActiveWorkbook.Sheets(i) 'Types 3 and 4 = Chart ... what else?
                GoTo GotChart
            Else
                GoTo GetNextSheet
            End If
             ' Skip empty sheets and hidden sheets
GotChart:
            If CurrentChart.Visible Then
                SheetCount = SheetCount + 1
                PrintDlg.CheckBoxes.Add 78, TopPos, 150, 16.5
                PrintDlg.CheckBoxes(SheetCount).Text = _
                CurrentChart.Name
                TopPos = TopPos + 13
                GoTo GetNextSheet
            End If
GotWorksheet:
            If Application.CountA(CurrentSheet.Cells) <> 0 And _
            CurrentSheet.Visible Then
                SheetCount = SheetCount + 1
                PrintDlg.CheckBoxes.Add 78, TopPos, 150, 16.5
                PrintDlg.CheckBoxes(SheetCount).Text = _
                CurrentSheet.Name
                TopPos = TopPos + 13
            End If
GetNextSheet:
        Next i
         ' Move the OK and Cancel buttons
        PrintDlg.Buttons.Left = 240
         ' Set dialog height, width, and caption
    With PrintDlg.DialogFrame
            .Height = Application.Max _
            (68, PrintDlg.DialogFrame.Top + TopPos - 34)
            .Width = 230
            .Caption = "Select sheets to print"
    End With
         ' Change tab order of OK and Cancel buttons
         ' so the 1st option button will have the focus
        PrintDlg.Buttons("Button 2").BringToFront
        PrintDlg.Buttons("Button 3").BringToFront
         ' Display the dialog box
        CurrentSheet.Activate
        Sheets(StartSheet).Activate
        Application.Cursor = xlDefault
        Application.ScreenUpdating = True
        If SheetCount <> 0 Then
             'Print as one print job (continuous page numbers)
             ' If PrintDlg.Show Then
             ' For Each cb In PrintDlg.CheckBoxes
             ' If cb.Value = xlOn Then
             ' Worksheets(cb.Caption).Select Replace:=False
             ' End If
             ' Next cb
             ' ActiveWindow.SelectedSheets.PrintOut copies:=1
             ' ActiveSheet.Select
             ' End If
             'Print as separate print jobs
            If PrintDlg.Show Then
                For Each cb In PrintDlg.CheckBoxes
                    If cb.Value = xlOn Then
                        Sheets(cb.Caption).Activate
                        ActiveSheet.PrintOut
                         ' ActiveSheet.PrintPreview 'for debugging
                    End If
                Next cb
            End If
        Else
            MsgBox "All worksheets are empty."
        End If
         ' Delete temporary dialog sheet (without a warning)
        Application.DisplayAlerts = False
        PrintDlg.Delete
         ' Reactivate original sheet
        Sheets(StartSheet).Activate
        Dim Wb As Workbook
        For Each Wb In Workbooks
        If Wb.Name <> ThisWorkbook.Name Then
            Wb.Close savechanges:=False
        End If
        Next Wb
        ActiveWorkbook.save
        
        .ProgressFinish 'This resets the statusbar
    End With
    Set spStatBar = Nothing
    MsgBox "File import completed", vbInformation, "Done"
    Application.ScreenUpdating = True
    Sheets("Start Here").Select
End Sub
 

Excel Facts

Can you sort left to right?
To sort left-to-right, use the Sort dialog box. Click Options. Choose "Sort left to right"

Joe Was

MrExcel MVP
Joined
Feb 19, 2002
Messages
7,539
Sub MyInPutShell()
'Standard Sheet Module Code!
'Universal InputBox shell.

Dim Message, Title, Default, Left, Down, HelpFile, HelpItem, MyValue
Dim MessageC, TitleC, DefaultC, MyValueC

'Note: Comment out the "On Error GoTo ErrorHandler" statement below when modifing!
On Error GoTo ErrorHandler
'Set the InPutBox up!
'If the user clicks "OK" or presses "ENTER," the InputBox returns whatever is in the text box.
'If the user clicks "Cancel," the zero-length string ("") is returned.
'Note: To specify more than a "prompt-message," you must use the "(syntax)" function below!
'To omit some function arguments, you must include the corresponding comma delimiter.


'InPutBox Syntax: InputBox(Message, Title, Default, Left, Down, HelpFile, HelpItem)
Message = "Enter an answer:" & vbCr & vbCr & _
"Note: Enter the word ""Skip"" to by-pass this question!" & vbCr & _
" Enter ""Help"" for information on this question!" 'Set prompt.
Title = "Question One!" 'Set title.
Default = "Skip" 'Set default.
'Horizontal distance of the left edge of the dialog box from the left edge of the screen.
'If omitted its default is about center over on the screen!

Left = 4000
'Upper edge of the dialog box from the top of the screen.
'If omitted its default is approximately one-third down the screen.

Down = 3000

'Display message, title, and default value.
myLoop:
MyValue = InputBox(Message, Title, Default, Left, Down)

'Check for "Help" request!
If UCase(MyValue) = "HELP" Then
'You must create a "HelpFileName.txt" in "NotePad" and
'indicate the path for this help option to work

Call Shell("NOTEPAD.EXE u:\Excel\Test\Q1Help.txt", 1)
GoTo myLoop
End If

'If no value is entered force the user to address this box!
If (MyValue = vbNullString Or MyValue = "" Or MyValue = " ") Then
MsgBox "You must answer this!", vbOKOnly + vbCritical, "Error!"
GoTo myLoop
End If

'The user chose to "Skip" this InputBox question!
If UCase(MyValue) = "SKIP" Then
GoTo myEnd
End If

'The InputBox got an answer from the user!
GoTo myFin

myEnd:
'User Skiped this one!
MsgBox Title & vbCr & "By-passed!", vbOKOnly + vbExclamation, "Warning!"
GoTo myWarn

myFin:
'User inputted "MyValue" as a good responce!
'Check for answer revision!
'Add other code here, as needed, to work with a good responce!

MessageC = "You inputed: " & MyValue & vbCr & vbCr & _
"Do you want to change your answer for: " & vbCr & Title & "?" & _
vbCr & vbCr & "Enter ""X"" to change your answer for: " & Title & _
vbCr & vbCr & "Enter ""Accept"" to save your answer " & _
"and go to the next question!" 'Set prompt.
TitleC = "Last Chance for: " & Title 'Set title.
DefaultC = "Accept" 'Set default.

'Display message, title, and default value for the fileName InPutBox.
MyValueC = InputBox(MessageC, TitleC, DefaultC)

'Test for revision!
If UCase(MyValueC) = "X" Then GoTo myLoop

'Add other code here to use the answer "MyValue" some way!
'Like:

MsgBox "MyValueC = " & MyValueC & vbCr & vbCr & "MyValue = " & MyValue

ErrorHandler:
'Trap Excel Run-Time-Errors!
If Err.Number <> 0 Then
myErr = MsgBox(prompt:="Error Number: " & Err.Number & vbCr & _
"Error Description: " & Err.Description & vbCr, Buttons:=vbMsgBoxHelpButton _
, Title:="Run-Time-Error Processing!" _
, HelpFile:=Err.HelpFile, Context:=Err.HelpContext)
End If

myWarn:
'Finish!
End Sub

Sub helpTextMaker()
'Standard Sheet Module code.
'Build a psudo Help file using Text-File calls.

Dim MessageF, TitleF, DefaultF, MyValueF
Dim MessageP, TitleP, DefaultP, MyValueP

'Get the name of the help file to make!
MessageF = "Enter a ""File Name"" below," & vbCr & _
"for your ""Help-Text-File!""" & vbCr & vbCr & _
"The syntax for your file's name is: anyName.txt" 'Set prompt.
TitleF = "Make or Edit a Help Text File!" 'Set title.
DefaultF = "TestHelp.txt" 'Set default.

'Display message, title, and default value for the fileName InPutBox.
MyValueF = InputBox(MessageF, TitleF, DefaultF)

'Get the "Path for your Help file to be stored at!
'You may wish to change "DefaultP" below to your path!

MessageP = "Enter a ""Drive-Path"" [Folder-Location]," & vbCr & _
"for your ""Help-Text-File"" to be stored at or" & vbCr & _
"where it is stored at now!" & vbCr & vbCr & _
"The syntax for your ""Folder-Location"" is: Drive:\Path" & vbCr & vbCr & _
"Note: You can ""Save"" or ""Save As""" & vbCr & _
" to a new name/location once you create/open it!" & vbCr & vbCr & _
" The Folder-Location entered must be a valid one!" & vbCr 'Set prompt.
TitleP = "Make Help Text File!" 'Set title.
DefaultP = "U:\Excel\Test" 'Set default.

'Display message, title, and default value for the Path InPutBox.
MyValueP = InputBox(MessageP, TitleP, DefaultP)

'Remind user to save the file before they exit the editor!
MsgBox "The Editor will now open." & vbCr & vbCr & _
"Note: After you enter your text," & vbCr & """Save"" before you ""Exit!""", _
vbOKOnly + vbInformation, "Note!"

Call Shell("NOTEPAD.EXE " & MyValueP & "\" & MyValueF, 1)

End Sub
 

LilStevie

Board Regular
Joined
Nov 13, 2006
Messages
232
Thanks Joe,

Works like a charm. Still learning VBA, like the looping you set up..
 

Forum statistics

Threads
1,182,185
Messages
5,934,135
Members
436,930
Latest member
jvinces

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top