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