Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Dynamic worksheet selection using messagebox
On the opening of an excel file with a number of worksheets named as
follows: FDC Packs Covers I would like the following to occur: 1. A selection list of the current worksheet names (these may change so I want this to be dynamic) to be displayed in some kind of message box (radio buttons, listbox,any method would do). 2. On selecting one of these and pressing OK, a Microsoft file selection window will be displayed ( this is to allow me to pick up a file of raw data from a folder) 3. When a file is selected and OK is pressed, the sheet selected will become the selected sheet and I will then perform some sheet specific code using the raw data to build a report in this worksheet. I realis this aspect will need to be hardcoded as I will need to recognise the worksheet selected via VBA code to run the correct code. I would love any help on this, including any simple example code that I can tailor. Thanks Mark |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Dynamic worksheet selection using messagebox
I just found this in my library of code; may get you started:
Sub BuildTOC() 'listed from active cell down 7-cols -- DMcRitchie 1999-08-14 2000-09-05 Dim iSheet As Long, iBefore As Long Dim sSheetName As String, sActiveCell As String Dim cRow As Long, cCol As Long, cSht As Long Dim lastcell Dim qSht As String Dim mg As String Dim rg As Range Dim CRLF As String Dim Reply As Variant Application.Calculation = xlCalculationManual Application.ScreenUpdating = False cRow = ActiveCell.Row cCol = ActiveCell.Column sSheetName = UCase(ActiveSheet.Name) sActiveCell = UCase(ActiveCell.Value) mg = "" CRLF = Chr(10) 'Actually just CR Set rg = Range(Cells(cRow, cCol), Cells(cRow - 1 + ActiveWorkbook.Sheets.Count, cCol + 7)) rg.Select If sSheetName < "$$TOC" Then mg = mg & "Sheetname is not $$TOC" & CRLF If sActiveCell < "$$TOC" Then mg = mg & "Selected cell value is not $$TOC" & CRLF If mg < "" Then mg = "Warning BuildTOC will destructively rewrite the selected area" _ & CRLF & CRLF & mg & CRLF & "Press OK to proceed, " _ & "the affected area will be rewritten, or" & CRLF & _ "Press CANCEL to check area then reinvoke this macro (BuildTOC)" Application.ScreenUpdating = True 'make range visible Reply = MsgBox(mg, vbOKCancel, "Create TOC for " & ActiveWorkbook.Sheets.Count _ & " items in workbook" & Chr(10) & "revised will now occupy up to 10 columns") Application.ScreenUpdating = False If Reply < 1 Then GoTo AbortCode End If rg.Clear 'Clear out any previous hyperlinks, fonts, etc in the area For cSht = 1 To ActiveWorkbook.Sheets.Count Cells(cRow - 1 + cSht, cCol) = "'" & Sheets(cSht).Name If TypeName(Sheets(cSht)) = "Worksheet" Then 'hypName = "'" & Sheets(csht).Name ' qSht = Replace(Sheets(cSht).Name, """", """""") -- replace not in XL97 qSht = Application.Substitute(Sheets(cSht).Name, """", """""") If CDbl(Application.Version) < 8# Then '-- use next line for XL95 Cells(cRow - 1 + cSht, cCol + 2) = "'" & Sheets(cSht).Name 'XL95 Else '-- Only for XL97, XL98, XL2000 -- will create hyperlink & codename Cells(cRow - 1 + cSht, cCol + 2) = "'" & Sheets(cSht).CodeName '--- excel is not handling lots of objects well --- 'ActiveSheet.Hyperlinks.Add Anchor:=Cells(cRow - 1 + cSht, cCol), _ ' Address:="", SubAddress:="'" & Sheets(cSht).Name & "'!A1" '--- so will use the HYPERLINK formula instead --- '--- =HYPERLINK("[VLOOKUP.XLS]'$$TOC'!A1","$$TOC") ActiveSheet.Cells(cRow - 1 + cSht, cCol).Formula = _ "=hyperlink(""[" & ActiveWorkbook.Name _ & "]'" & qSht & "'!A1"",""" & qSht & """)" End If Else Cells(cRow - 1 + cSht, cCol + 2) = "'" & Sheets(cSht).Name End If Cells(cRow - 1 + cSht, cCol + 1) = TypeName(Sheets(cSht)) ' -- activate next line to include content of cell A1 for each sheet ' Cells(cRow - 1 + csht, cCol + 3) = Sheets(Sheets(csht).Name).Range("A1").Value On Error Resume Next Cells(cRow - 1 + cSht, cCol + 6) = Sheets(cSht).ScrollArea '.Address(0, 0) Cells(cRow - 1 + cSht, cCol + 7) = Sheets(cSht).PageSetup.PrintArea If TypeName(Sheets(cSht)) < "Worksheet" Then GoTo byp7 Set lastcell = Sheets(cSht).Cells.SpecialCells(xlLastCell) Cells(cRow - 1 + cSht, cCol + 4) = lastcell.Address(0, 0) Cells(cRow - 1 + cSht, cCol + 5) = lastcell.Column * lastcell.Row byp7: 'xxx On Error GoTo 0 Next cSht 'Now sort the results: 2. Type(D), 1. Name (A), 3. module(unsorted) rg.Sort Key1:=rg.Cells(1, 2), Order1:=xlDescending, Key2:=rg.Cells(1, 1) _ , Order2:=xlAscending, Header:=xlNo, OrderCustom:=1, MatchCase:=False, _ Orientation:=xlTopToBottom rg.Columns.AutoFit rg.Select 'optional 'if cells above range are blank want these headers ' Worksheet, Type, codename If cRow 1 Then If "" = Trim(Cells(cRow - 1, cCol) & Cells(cRow - 1, cCol + 1) & Cells(cRow - 1, cCol + 2)) Then Cells(cRow - 1, cCol) = "Worksheet" Cells(cRow - 1, cCol + 1) = "Type" Cells(cRow - 1, cCol + 2) = "CodeName" Cells(cRow - 1, cCol + 3) = "[opt.]" Cells(cRow - 1, cCol + 4) = "Lastcell" Cells(cRow - 1, cCol + 5) = "cells" Cells(cRow - 1, cCol + 6) = "ScrollArea" Cells(cRow - 1, cCol + 7) = "PrintArea" End If End If Application.ScreenUpdating = True Reply = MsgBox("Table of Contents created." & CRLF & CRLF & _ "Would you like the tabs in workbook also sorted", _ vbOKCancel, "Option to Sort " & ActiveWorkbook.Sheets.Count _ & " tabs in workbook") Application.ScreenUpdating = False 'If Reply = 1 Then SortALLSheets 'Invoke macro to Sort Sheet Tabs Sheets(sSheetName).Activate AbortCode: Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic End Sub -- Ryan--- If this information was helpful, please indicate this by clicking ''Yes''. "stainless" wrote: On the opening of an excel file with a number of worksheets named as follows: FDC Packs Covers I would like the following to occur: 1. A selection list of the current worksheet names (these may change so I want this to be dynamic) to be displayed in some kind of message box (radio buttons, listbox,any method would do). 2. On selecting one of these and pressing OK, a Microsoft file selection window will be displayed ( this is to allow me to pick up a file of raw data from a folder) 3. When a file is selected and OK is pressed, the sheet selected will become the selected sheet and I will then perform some sheet specific code using the raw data to build a report in this worksheet. I realis this aspect will need to be hardcoded as I will need to recognise the worksheet selected via VBA code to run the correct code. I would love any help on this, including any simple example code that I can tailor. Thanks Mark . |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Dynamic worksheet selection using messagebox
Give this a go:
Sub GoToSheet() myShts = ActiveWorkbook.Sheets.Count For i = 1 To myShts myList = myList & i & " - " & ActiveWorkbook.Sheets(i).Name & " " & vbCr Next i Dim mySht As Single mySht = InputBox("Select sheet to go to." & vbCr & vbCr & myList) Sheets(mySht).Select End Sub -- Ryan--- If this information was helpful, please indicate this by clicking ''Yes''. "ryguy7272" wrote: I just found this in my library of code; may get you started: Sub BuildTOC() 'listed from active cell down 7-cols -- DMcRitchie 1999-08-14 2000-09-05 Dim iSheet As Long, iBefore As Long Dim sSheetName As String, sActiveCell As String Dim cRow As Long, cCol As Long, cSht As Long Dim lastcell Dim qSht As String Dim mg As String Dim rg As Range Dim CRLF As String Dim Reply As Variant Application.Calculation = xlCalculationManual Application.ScreenUpdating = False cRow = ActiveCell.Row cCol = ActiveCell.Column sSheetName = UCase(ActiveSheet.Name) sActiveCell = UCase(ActiveCell.Value) mg = "" CRLF = Chr(10) 'Actually just CR Set rg = Range(Cells(cRow, cCol), Cells(cRow - 1 + ActiveWorkbook.Sheets.Count, cCol + 7)) rg.Select If sSheetName < "$$TOC" Then mg = mg & "Sheetname is not $$TOC" & CRLF If sActiveCell < "$$TOC" Then mg = mg & "Selected cell value is not $$TOC" & CRLF If mg < "" Then mg = "Warning BuildTOC will destructively rewrite the selected area" _ & CRLF & CRLF & mg & CRLF & "Press OK to proceed, " _ & "the affected area will be rewritten, or" & CRLF & _ "Press CANCEL to check area then reinvoke this macro (BuildTOC)" Application.ScreenUpdating = True 'make range visible Reply = MsgBox(mg, vbOKCancel, "Create TOC for " & ActiveWorkbook.Sheets.Count _ & " items in workbook" & Chr(10) & "revised will now occupy up to 10 columns") Application.ScreenUpdating = False If Reply < 1 Then GoTo AbortCode End If rg.Clear 'Clear out any previous hyperlinks, fonts, etc in the area For cSht = 1 To ActiveWorkbook.Sheets.Count Cells(cRow - 1 + cSht, cCol) = "'" & Sheets(cSht).Name If TypeName(Sheets(cSht)) = "Worksheet" Then 'hypName = "'" & Sheets(csht).Name ' qSht = Replace(Sheets(cSht).Name, """", """""") -- replace not in XL97 qSht = Application.Substitute(Sheets(cSht).Name, """", """""") If CDbl(Application.Version) < 8# Then '-- use next line for XL95 Cells(cRow - 1 + cSht, cCol + 2) = "'" & Sheets(cSht).Name 'XL95 Else '-- Only for XL97, XL98, XL2000 -- will create hyperlink & codename Cells(cRow - 1 + cSht, cCol + 2) = "'" & Sheets(cSht).CodeName '--- excel is not handling lots of objects well --- 'ActiveSheet.Hyperlinks.Add Anchor:=Cells(cRow - 1 + cSht, cCol), _ ' Address:="", SubAddress:="'" & Sheets(cSht).Name & "'!A1" '--- so will use the HYPERLINK formula instead --- '--- =HYPERLINK("[VLOOKUP.XLS]'$$TOC'!A1","$$TOC") ActiveSheet.Cells(cRow - 1 + cSht, cCol).Formula = _ "=hyperlink(""[" & ActiveWorkbook.Name _ & "]'" & qSht & "'!A1"",""" & qSht & """)" End If Else Cells(cRow - 1 + cSht, cCol + 2) = "'" & Sheets(cSht).Name End If Cells(cRow - 1 + cSht, cCol + 1) = TypeName(Sheets(cSht)) ' -- activate next line to include content of cell A1 for each sheet ' Cells(cRow - 1 + csht, cCol + 3) = Sheets(Sheets(csht).Name).Range("A1").Value On Error Resume Next Cells(cRow - 1 + cSht, cCol + 6) = Sheets(cSht).ScrollArea '.Address(0, 0) Cells(cRow - 1 + cSht, cCol + 7) = Sheets(cSht).PageSetup.PrintArea If TypeName(Sheets(cSht)) < "Worksheet" Then GoTo byp7 Set lastcell = Sheets(cSht).Cells.SpecialCells(xlLastCell) Cells(cRow - 1 + cSht, cCol + 4) = lastcell.Address(0, 0) Cells(cRow - 1 + cSht, cCol + 5) = lastcell.Column * lastcell.Row byp7: 'xxx On Error GoTo 0 Next cSht 'Now sort the results: 2. Type(D), 1. Name (A), 3. module(unsorted) rg.Sort Key1:=rg.Cells(1, 2), Order1:=xlDescending, Key2:=rg.Cells(1, 1) _ , Order2:=xlAscending, Header:=xlNo, OrderCustom:=1, MatchCase:=False, _ Orientation:=xlTopToBottom rg.Columns.AutoFit rg.Select 'optional 'if cells above range are blank want these headers ' Worksheet, Type, codename If cRow 1 Then If "" = Trim(Cells(cRow - 1, cCol) & Cells(cRow - 1, cCol + 1) & Cells(cRow - 1, cCol + 2)) Then Cells(cRow - 1, cCol) = "Worksheet" Cells(cRow - 1, cCol + 1) = "Type" Cells(cRow - 1, cCol + 2) = "CodeName" Cells(cRow - 1, cCol + 3) = "[opt.]" Cells(cRow - 1, cCol + 4) = "Lastcell" Cells(cRow - 1, cCol + 5) = "cells" Cells(cRow - 1, cCol + 6) = "ScrollArea" Cells(cRow - 1, cCol + 7) = "PrintArea" End If End If Application.ScreenUpdating = True Reply = MsgBox("Table of Contents created." & CRLF & CRLF & _ "Would you like the tabs in workbook also sorted", _ vbOKCancel, "Option to Sort " & ActiveWorkbook.Sheets.Count _ & " tabs in workbook") Application.ScreenUpdating = False 'If Reply = 1 Then SortALLSheets 'Invoke macro to Sort Sheet Tabs Sheets(sSheetName).Activate AbortCode: Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic End Sub -- Ryan--- If this information was helpful, please indicate this by clicking ''Yes''. "stainless" wrote: On the opening of an excel file with a number of worksheets named as follows: FDC Packs Covers I would like the following to occur: 1. A selection list of the current worksheet names (these may change so I want this to be dynamic) to be displayed in some kind of message box (radio buttons, listbox,any method would do). 2. On selecting one of these and pressing OK, a Microsoft file selection window will be displayed ( this is to allow me to pick up a file of raw data from a folder) 3. When a file is selected and OK is pressed, the sheet selected will become the selected sheet and I will then perform some sheet specific code using the raw data to build a report in this worksheet. I realis this aspect will need to be hardcoded as I will need to recognise the worksheet selected via VBA code to run the correct code. I would love any help on this, including any simple example code that I can tailor. Thanks Mark . |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Dynamic worksheet selection using messagebox
On Sat, 20 Feb 2010 13:28:03 -0800, ryguy7272
wrote: Give this a go: Sub GoToSheet() myShts = ActiveWorkbook.Sheets.Count For i = 1 To myShts myList = myList & i & " - " & ActiveWorkbook.Sheets(i).Name & " " & vbCr Next i Dim mySht As Single mySht = InputBox("Select sheet to go to." & vbCr & vbCr & myList) Sheets(mySht).Select End Sub Or do it without code via a simple drop down list that references to a table of your desired selections, which would be a hyperlink to the selected sheet. |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Dynamic Range Selection | Excel Programming | |||
Dynamic Range Selection | Excel Programming | |||
VBA Dynamic Selection | Excel Programming | |||
Messagebox: Alert user Worksheet is Unprotected | Excel Programming | |||
Dynamic Row Selection | Excel Programming |