We help IT Professionals succeed at work.

Check out our new AWS podcast with Certified Expert, Phil Phillips! Listen to "How to Execute a Seamless AWS Migration" on EE or on your favorite podcast platform. Listen Now

x

Macro to select active sheet based on inputbox

Medium Priority
765 Views
Last Modified: 2012-05-11
Hello Experts,

The attached excel workbook has three worksheets. Request a macro that would would include a input box that would have three choices Model 1, Model 2 and Model 3, and would select the correct worksheet and delete the other two work sheets. Inaddition an input box that would populate a tail number that is entered in cell A1 on the correct sheet.

Thanks

Norm

CABIN-SEATS.xls
Comment
Watch Question

CERTIFIED EXPERT
Most Valuable Expert 2011
Top Expert 2011

Commented:
Try this:
Sub SetUpSheets()
   Dim strSheet As String, strTail
   Dim wksKeep As Worksheet, wks As Worksheet
   Do
      strSheet = InputBox("Enter a sheet name to use", "Select sheet")
      If strSheet = "" Then
         Exit Sub
      Else
         On Error Resume Next
         Set wksKeep = Sheets(strSheet)
         On Error GoTo 0
         If wksKeep Is Nothing Then
            MsgBox "Invalid name - please try again (Check spelling)"
         End If
      End If
   Loop While wksKeep Is Nothing
   Application.DisplayAlerts = False
   For Each wks In ThisWorkbook.Worksheets
      If wks.Name <> wksKeep.Name Then wks.Delete
   Next wks
   Application.DisplayAlerts = True
   strTail = InputBox("Enter a tail number")
   wksKeep.Range("A1").Value = strTail
End Sub

Open in new window

Use this macro
Sub GetUserInput()
Dim i As String
i = InputBox("Please enter model number", "Get User Input", "None")
If LCase(i) <> "model 1" And i <> "model 2" And i <> "model 3" Then
    MsgBox "Incorrect choice! Please select Model 1, Model 2 or Model 3 only!!"
Else
    Dim w As Workbook
    Set w = ActiveWorkbook
    Dim t As String
    t = InputBox("Please enter tail number", "Get User Input", "None")
    If t <> "" Then
        If Mid(i, 7, 1) = 1 Then
             w.Worksheets("MODEL 2").Delete
             w.Worksheets("MODEL 3").Delete
             w.Worksheets("MODEL 1").Cells(1, 1).Value = t
        ElseIf Mid(i, 7, 1) = 2 Then
            w.Worksheets("MODEL 1").Delete
            w.Worksheets("MODEL 3").Delete
            w.Worksheets("MODEL 2").Cells(1, 1).Value = t
        ElseIf Mid(i, 7, 1) = 3 Then
            w.Worksheets("MODEL 1").Delete
            w.Worksheets("MODEL 2").Delete
            w.Worksheets("MODEL 3").Cells(1, 1).Value = t
        End If
    Else
        MsgBox "Please enter some value in Tail Number"
    End If
End If
End Sub

Open in new window

Author

Commented:
rorya,

I got your macro to work; however could you amend it to hide the worksheets instead of deleting them?

Thanks
CERTIFIED EXPERT
Most Valuable Expert 2011
Top Expert 2011

Commented:
Sure:
Sub SetUpSheets()
   Dim strSheet As String, strTail
   Dim wksKeep As Worksheet, wks As Worksheet
   Do
      strSheet = InputBox("Enter a sheet name to use", "Select sheet")
      If strSheet = "" Then
         Exit Sub
      Else
         On Error Resume Next
         Set wksKeep = Sheets(strSheet)
         On Error GoTo 0
         If wksKeep Is Nothing Then
            MsgBox "Invalid name - please try again (Check spelling)"
         End If
      End If
   Loop While wksKeep Is Nothing
   For Each wks In ThisWorkbook.Worksheets
      If wks.Name <> wksKeep.Name Then wks.Visible = xlSheetHidden
   Next wks
   strTail = InputBox("Enter a tail number")
   wksKeep.Range("A1").Value = strTail
End Sub

Open in new window

Author

Commented:
rorya,

This is working good. One last thing I need is it to have a reset that would bring back all the hidden sheets - in case a mistake is made, or reset (unhide all worksheets) so the original macro will run.
CERTIFIED EXPERT
Most Valuable Expert 2011
Top Expert 2011
Commented:
Unlock this solution with a free trial preview.
(No credit card required)
Get Preview

Author

Commented:
Thanx
Unlock the solution to this question.
Thanks for using Experts Exchange.

Please provide your email to receive a free trial preview!

*This site is protected by reCAPTCHA and the Google Privacy Policy and Terms of Service apply.

OR

Please enter a first name

Please enter a last name

8+ characters (letters, numbers, and a symbol)

By clicking, you agree to the Terms of Use and Privacy Policy.