I have 3 workbooks each containing the days of the month with data for 3 districts. The layout is identical, only the data differs. I want to create the a summary sheet compiling data for each specific day on the day. In my summary workbook, I am able to open the workbooks, then copy the data. However to make it user friendly i am using a function by John Whalkenbach called "getoption_function". http://spreadsheetpage.com/index.php/fi ... _function/
This is my steps i am following:
1. open the workbooks in question
2. create an array of the sheetnames
3. select which sheet i want to compile
4. select and copy back to the summary workbook
The problem:
after populating the popup with the various sheetnames, i need to copy that sheet contents. i am stuck on selecting the specific sheet based on my option button selection and writing it back to the summary sheet.
here is the code to open and copy the data from the specific sheet (sheetname and workbook hard coded)
Code: Select all
Sub combine_data()
Dim ws As Worksheet
Dim x As Long
Dim rng As Range
Dim fPath As String
Dim myWb As String
Dim sName As String
Dim wbTarget As Workbook
Dim wbkFetch As Workbook
Dim sh As Worksheet
Set wbTarget = ActiveWorkbook
myWb = "May_2014.xlsm" 'HAVE TO MAKE THIS A DYNAMIC SELECTION
fPath = ThisWorkbook.Path
sName = fPath & "\" & myWb
Set wbkFetch = Workbooks.Open(Filename:=sName)
'copy the sheetnames from query workbook to temp sheet first to build the options dialog
For Each sh In wbkFetch.Worksheets
If sh.Name <> "Ranges" Then
For x = 2 To Worksheets.Count
wbTarget.Sheets("Temp").Cells(x, 1).Value = Worksheets(x).Name
Next x
End If
Next sh
'clear any thing on clipboard to maximize available memory
Application.CutCopyMode = False
'copy from first workbook
wbkFetch.Sheets("May 1st").Range("H8: AL27").Select 'HAVE TO MAKE THIS A DYNAMIC SELECTION
Selection.Copy
wbTarget.Activate
' wbTarget.Sheets("Summary").Range("H15:AL34").ClearContents 'clear existing values form target book
wbTarget.Sheets("Summary").Range("H15:AL34").PasteSpecial (xlPasteValues) 'now paste to this workbook
'clear any thing on clipboard to maximize available memory
Application.CutCopyMode = False
'close workbooks
wbkFetch.Close
'clear memory
Set wbTarget = Nothing
Set wbkFetch = Nothing
End SubCode: Select all
Option Explicit
Option Base 1
'* Adapted from :http://spreadsheetpage.com/index.php/file/getoption_function/
Sub DemoOptionButtons()
Dim x As Integer
Dim sh As Worksheet
x = Sheets("Temp").Range("D3").Value
Dim Ops() As Variant
Dim i As Integer
Dim UserChoice As Variant
' Create an array of sheet names
For i = 1 To x
ReDim Preserve Ops(1 To i)
Ops(i) = Sheets("Temp").Range("A" & i).Value
Next i
UserChoice = GetOptionFromForm(Ops, 0, "Make your choice")
If UserChoice <> False Then
MsgBox "Selected element nr" & Chr(6) & ": " & UserChoice & vbCrLf & _
"Corresponds to" & Chr(5) & ": " & Ops(UserChoice), vbInformation, ""
Else
MsgBox "No choice made!", vbExclamation, x & " elements available!"
End If
End Sub
Code: Select all
Option Explicit
'Passed back to the function from the UserForm
Public GETOPTION_RET_VAL As Variant
Function GetOption(OpArray, Default, Title)
Dim TempForm 'As VBComponent
Dim NewOptionButton As Msforms.OptionButton
Dim NewCommandButton1 As Msforms.CommandButton
Dim NewCommandButton2 As Msforms.CommandButton
Dim TextLocation As Integer
Dim X As Integer, i As Integer, TopPos As Integer
Dim MaxWidth As Long
Dim WasVisible As Boolean
' Hide VBE window to prevent screen flashing
Application.VBE.MainWindow.Visible = False
' Create the UserForm
Set TempForm = ThisWorkbook.VBProject.VBComponents.Add(3)
TempForm.Properties("Width") = 800
' Add the OptionButtons
TopPos = 4
MaxWidth = 0 'Stores width of widest OptionButton
For i = LBound(OpArray) To UBound(OpArray)
Set NewOptionButton = TempForm.Designer.Controls.Add("forms.OptionButton.1")
With NewOptionButton
.Width = 800
.Caption = OpArray(i)
.Height = 15
.Left = 8
.Top = TopPos
.Tag = i
.AutoSize = True
If Default = i Then .Value = True
If .Width > MaxWidth Then MaxWidth = .Width
End With
TopPos = TopPos + 15
Next i
' Add the Cancel button
Set NewCommandButton1 = TempForm.Designer.Controls.Add("forms.CommandButton.1")
With NewCommandButton1
.Caption = "Cancel"
.Height = 18
.Width = 44
.Left = MaxWidth + 12
.Top = 6
End With
' Add the OK button
Set NewCommandButton2 = TempForm.Designer.Controls.Add("forms.CommandButton.1")
With NewCommandButton2
.Caption = "OK"
.Height = 18
.Width = 44
.Left = MaxWidth + 12
.Top = 28
End With
' Add event-hander subs for the CommandButtons
With TempForm.CodeModule
X = .CountOfLines
.InsertLines X + 1, "Sub CommandButton1_Click()"
.InsertLines X + 2, " GETOPTION_RET_VAL=False"
.InsertLines X + 3, " Unload Me"
.InsertLines X + 4, "End Sub"
.InsertLines X + 5, "Sub CommandButton2_Click()"
.InsertLines X + 6, " Dim ctl"
.InsertLines X + 7, " GETOPTION_RET_VAL = False"
.InsertLines X + 8, " For Each ctl In Me.Controls"
.InsertLines X + 9, " If ctl.Tag <> """" Then If ctl Then GETOPTION_RET_VAL = ctl.Tag"
.InsertLines X + 10, " Next ctl"
.InsertLines X + 11, " Unload Me"
.InsertLines X + 12, "End Sub"
End With
' Adjust the form
With TempForm
.Properties("Caption") = Title
.Properties("Width") = NewCommandButton1.Left + NewCommandButton1.Width + 10
If .Properties("Width") < 160 Then
.Properties("Width") = 160
NewCommandButton1.Left = 106
NewCommandButton2.Left = 106
End If
.Properties("Height") = TopPos + 24
End With
' Show the form
VBA.UserForms.Add(TempForm.Name).Show
' Delete the form
ThisWorkbook.VBProject.VBComponents.Remove VBComponent:=TempForm
' Pass the selected option back to the calling procedure
GetOption = GETOPTION_RET_VAL
End Function
