COMBO-FILTER Ver1

[LinuxGuy]

ref : ("Code below&quot
I'd Like to NOt Show the Entire Path Of the XLS Files In the Combo Box Just the
XLS Names and Extension..
This Code Open's the Combo Selected XLS Workbook In a Whole new Excel Instance..
I Want the Selected sheet to Open In another Sheet TAB in the Current Workbook
Not another EXCEL Instance.....(" PLEASE HELP" )

Private Sub Worksheet_Activate()
With Application.FileSearch
.NewSearch
.LookIn = "C:\MyDir\files"
.SearchSubFolders = False
.Filename = "*.xls"
If .Execute > 0 Then
For i = 1 To .FoundFiles.Count
ComboBox1.AddItem .FoundFiles(i)
Next i
End If
End With
End Sub

' /// then In the change event of the COmbo Box i have

Private Sub ComboBox1_Change()
strSelect = ComboBox1.Value
Workbooks.Open Filename:=strSelect
End Sub

 

[rmikesmith]

LinuxGuy,

To add only filenames (no path) to the combobox, add the following function (taken from John Walkenbach's "Power Programming With VBA&quot to a code module:

Private Function FileNameOnly(pname) As String
'   Returns the filename from a path/filename string
    Dim i As Integer, length As Integer, temp As String
    length = Len(pname)
    temp = ""
    For i = length To 1 Step -1
        If Mid(pname, i, 1) = Application.PathSeparator Then
            FileNameOnly = temp
            Exit Function
        End If
        temp = Mid(pname, i, 1) & temp
    Next i
    FileNameOnly = pname
End Function

Now modify your Worksheet_Activate event procedure:

Private Sub Worksheet_Activate()
  With Application.FileSearch
    .NewSearch
    .LookIn = "C:\MyDir\files"
    .SearchSubFolders = False
    .Filename = "*.xls"
    If .Execute > 0 Then
      For i = 1 To .FoundFiles.Count
        ComboBox1.AddItem FileNameOnly(.FoundFiles(i))
      Next i
    End If
  End With
End Sub

You will need to also modify the combobox change event procedure:

Private Sub ComboBox1_Change()
strSelect = Application.FileSearch.LookIn &Application.PathSeparator &ComboBox1.Value
Workbooks.Open Filename:=strSelect
End Sub

As to the second part of your question, the only way to do this is open the second workbook (as your are currently doing), copy the sheet or sheets to the current workbook, then close the second workbook.

HTH
Mike

 

[rmikesmith]

Here is a modified version of the combobox change event handler that copies all sheets in the opened workbook to the workbook running the code:

Private Sub ComboBox1_Change()
Dim strSelect As String
Dim Wkb As Workbook
Dim Wks As Worksheet

  strSelect = Application.FileSearch.LookIn & Application.PathSeparator & ComboBox1.Value
  Set Wkb = Workbooks.Open(Filename:=strSelect)

  With Wkb
    For Each Wks In Wkb.Sheets
      Wks.Copy Before:=ThisWorkbook.Sheets(1)
    Next Wks
    .Close  'If no longer needed.  Could also be deleted.
  End With

End Sub

Note: If only one worksheet out of two or more is to be copied, then the For..Each loop would be replaced with the specific worksheet reference.

Regards,
Mike

 

[alibongo]

Hello chaps,

Sorry to butt in - if this thread is till running.I have been working with what I think it is a similar situation, perhaps you may find this interesting amd you may also be able to help me tidy up my code as it takes ages to run when there is lot of data loaded in my tool.
It may be useful if you want to copy multiple worksheets to your currentworksheet, to initiate the load from a list box and have a load button once you have selected the worksheets you want to copy across. This code will find the first available row (blank) to add the new data, if you are interested I can show you the other subs such as FindEnd etc, although they are quite simple. Forgive any messy code, I am not an expert.

Private Sub LoadCDRCollector_Click()

Dim strFileNamePrefix As String
Dim strMsg As String
Dim i As Integer
Dim strDate As Style
Dim strMonth As String
Dim strSheetName As String
Dim iQuery As Integer
Dim strFileName As String
Dim iQStart As Integer
Dim strSortColumn As String
Dim iColumn As Integer
Dim strLoadedFolder As String
Dim strCurrentWorkbook As String
Dim NewSheet As Worksheet
Dim bNewData As Boolean
Dim strSourceSheet As String
Dim n As Integer
Dim j As Integer
Dim oSourceSheet As Object
Dim oSourceWorkSheet As Object

strFileNamePrefix = cFolderPath & cCDRCollectorFolder
strSourceSheet = "Queryman"
strSheetName = "CDRCollector"
strLoadedFolder = "Loaded\"

'Initialise new data flag
bNewData = False

'Get the files from the list box
For i = 0 To ReconControlBox.CDRCollector.ListCount - 1
If ReconControlBox.CDRCollector.Selected(i) Then 'If a file is selected

strFileName = ReconControlBox.CDRCollector.List(i)
iQStart = InStr(1, strFileName, "q&quot 'Find the start of the query

If iQStart = 0 Then
MsgBox "A file name " & strFileName & " with an invalid format was found - exiting load"
Exit Sub
End If

iQuery = CInt(Mid(strFileName, iQStart + 1, Len(strFileName) - 4 - iQStart + 1))
strMonth = getTextMonth(Mid(strFileName, 5, 2))
If strMonth <> &quot;Not found&quot; Then
'Check if a sheet exist for this month
'Activate the workbook
ThisWorkbook.Activate
If Not (SheetExists(strSheetName & strMonth)) Then 'If the sheet doesn't exist then create a new one,
'add the headings, name a range for the last date, and then create the pivot table

'Get the workbook name
strCurrentWorkbook = ThisWorkbook.Name
'Add a new worksheet
Set NewSheet = Workbooks(strCurrentWorkbook).Worksheets.Add
NewSheet.Name = strSheetName & strMonth

'Insert the headings at the top of the sheet
InsertHeadings 1, 57, _
&quot;Switch ID,Trunk ID,Total Calls,Date, ,&quot; & _
&quot;Switch ID,Trunk ID,Total Seconds,Date, ,&quot; & _
&quot;Switch ID,Total_iy3,Date, ,&quot; & _
&quot;Switch ID,Total_id1_inbound,Date, ,&quot; & _
&quot;Switch ID,Total_id1_outbound,Date, ,&quot; & _
&quot;Switch ID,Total_ia1_iy1,Date, ,&quot; & _
&quot;Switch ID,Total_id2,Date, ,&quot; & _
&quot;Switch ID,Total_ia2_iy2,Date, ,&quot; & _
&quot;Switch ID,Total_id1_inbound_duration,Date, ,&quot; & _
&quot;Switch ID,Total_id1_outbound_duration,Date, ,&quot; & _
&quot;Switch ID,Total_ia1_iy1_duration,Date, ,&quot; & _
&quot;Switch ID,Total_id2_duration,Date, ,&quot; & _
&quot;Switch ID,Total_ia2_iy2_duration,Date, ,&quot; & _
&quot;Switch ID,Total_id1_inbound_Arbor,Date&quot;

'Name the ranges for the source data
NewSheet.Range(&quot;A&quot.Name = strSheetName & &quot;_&quot; & strMonth & &quot;_Q1&quot; & &quot;_SourceData&quot;
NewSheet.Range(&quot;F:I&quot.Name = strSheetName & &quot;_&quot; & strMonth & &quot;_Q2&quot; & &quot;_SourceData&quot;
NewSheet.Range(&quot;K:M&quot.Name = strSheetName & &quot;_&quot; & strMonth & &quot;_Q3&quot; & &quot;_SourceData&quot;
NewSheet.Range(&quot;O:Q&quot.Name = strSheetName & &quot;_&quot; & strMonth & &quot;_Q4&quot; & &quot;_SourceData&quot;
NewSheet.Range(&quot;S:U&quot.Name = strSheetName & &quot;_&quot; & strMonth & &quot;_Q5&quot; & &quot;_SourceData&quot;
NewSheet.Range(&quot;W:Y&quot.Name = strSheetName & &quot;_&quot; & strMonth & &quot;_Q6&quot; & &quot;_SourceData&quot;
NewSheet.Range(&quot;AA:AC&quot.Name = strSheetName & &quot;_&quot; & strMonth & &quot;_Q7&quot; & &quot;_SourceData&quot;
NewSheet.Range(&quot;AE:AG&quot.Name = strSheetName & &quot;_&quot; & strMonth & &quot;_Q8&quot; & &quot;_SourceData&quot;
NewSheet.Range(&quot;AI:AK&quot.Name = strSheetName & &quot;_&quot; & strMonth & &quot;_Q9&quot; & &quot;_SourceData&quot;
NewSheet.Range(&quot;AM:AO&quot.Name = strSheetName & &quot;_&quot; & strMonth & &quot;_Q10&quot; & &quot;_SourceData&quot;
NewSheet.Range(&quot;AQ:AS&quot.Name = strSheetName & &quot;_&quot; & strMonth & &quot;_Q11&quot; & &quot;_SourceData&quot;
NewSheet.Range(&quot;AU:AW&quot.Name = strSheetName & &quot;_&quot; & strMonth & &quot;_Q12&quot; & &quot;_SourceData&quot;
NewSheet.Range(&quot;AY:BA&quot.Name = strSheetName & &quot;_&quot; & strMonth & &quot;_Q13&quot; & &quot;_SourceData&quot;
NewSheet.Range(&quot;BC:BE&quot.Name = strSheetName & &quot;_&quot; & strMonth & &quot;_Q14&quot; & &quot;_SourceData&quot;

'Add the pivot tables
AddCDRCollectorPivotTables strMonth
Else

Set oDestinationSheet = ThisWorkbook.Worksheets(strSheetName & strMonth)
End If 'Sheetexists

Select Case iQuery
Case 1, 2
strSortColumn = &quot;D&quot;
iColumn = 5 * (iQuery - 1) + 1
Case 3
oDestinationSheet.Activate
strSortColumn = &quot;C&quot;
iColumn = 4 * (iQuery - 1) + 3

iStartRow = FindEnd(iColumn)
'Create the xls file name the file to be used
strSourceWorksheet = strSourceSheet
strSourceWorkbook = strFilePrefix & strFileName

If oFSO.FileExists(strSourceWorkbook) Then 'a file is found

'Open the source workbook
OpenSourceWorkBook (strSourceWorkbook)

Worksheets(strSourceWorksheet).Activate

'Set oSourceSheet = Workbooks(strSourceWorkbook).Worksheets(strSourceWorkSheet)
Set oSourceSheet = ActiveSheet



'Activate the sheet that is going to be used
oSourceSheet.Activate

'Set the start row for the source data
n = 2

'Set the start row for the destination data
j = iStartRow

Do While oSourceSheet.Cells(n, 1) <> &quot;&quot;

oDestinationSheet.Cells(j, iColumn).Value = &quot;CKP.jupiter.ods.&quot; & strCDRType & &quot;.calls&quot;
oDestinationSheet.Cells(j, iColumn + 1).Value = oSourceSheet.Cells(n, 3)
oDestinationSheet.Cells(j, iColumn + 2).Value = iDay
j = j + 1
n = n + 1

Loop


Case 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14
strSortColumn = &quot;C&quot;
iColumn = 4 * (iQuery - 1) + 3
Case Else
MsgBox &quot;A file name &quot; & strFileName & &quot; with an invalid format was found - exiting load&quot;
Exit Sub
End Select

CopyDataToSheet strFileNamePrefix, strFileName, strSourceSheet, strSortColumn, strSheetName, strMonth, iColumn, strLoadedFolder
bNewData = True
Else
MsgBox &quot;A file name &quot; & strFileName & &quot; with an invalid month was found - the file was not loaded&quot;
End If 'strMonth

End If 'File selected
Next

If bNewData Then
RefreshCDRCollectorPivotTables strMonth
End If

'Reload the dialogue box
KillReconControlBox
ShowReconControlBox

End Sub 'LoadCDRCollector_Click()

The copy data to sheet function

Sub CopyDataToSheet(strFileNamePrefix, strSourceWorkbook, strSourceSheet, strSortColumn, strSheetName, strMonth, iColumn, strLoadedFolder)
'Sub to copy data from a source sheet to a named sheet (strSheetName) for a month (strMonth)
'The data is sorted before is it copied
'After the copy, the source file is moved to the folder specified in strLoadedFolder
'If &quot;NoMove&quot; is specified as the folder name then it is not moved

Dim strCurrentWorkbook As String
Dim oSourceWorkSheet As Worksheet
Dim oDestinationWorksheet As Worksheet
Dim oFSO As Object

Application.DisplayAlerts = False
Application.ScreenUpdating = False


'Get the current workbook name
strCurrentWorkbook = ThisWorkbook.Name
'Open the source workbook
OpenSourceWorkBook (strFileNamePrefix & strSourceWorkbook)

Set oDestinationWorksheet = Workbooks(strCurrentWorkbook).Worksheets(strSheetName & strMonth)

'Sort the data before copying
Worksheets(strSourceSheet).Range(&quot;A1&quot.Sort _
Key1:=Worksheets(strSourceSheet).Columns(strSortColumn), Order1:=xlAscending, _
Key2:=Worksheets(strSourceSheet).Columns(&quot;A&quot, _
Header:=xlGuess

'Copy the data
ActiveSheet.UsedRange.Copy

'Activate the destination sheet
oDestinationWorksheet.Activate

'Paste the values after any existing data
Cells(FindEnd(iColumn), iColumn).PasteSpecial Paste:=xlValues

Workbooks(strSourceWorkbook).Close

If strLoadedFolder <> &quot;NoMove&quot; Then
'Move the file to the completed folder
' Set up global data.This line sets up a variable to access the file system
Set oFSO = CreateObject(&quot;Scripting.FileSystemObject&quot
oFSO.MoveFile strFileNamePrefix & strSourceWorkbook, strFileNamePrefix & strLoadedFolder
End If

Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub 'CopyDataToSheet

 

[rmikesmith]

Alibongo,

Whew! That's alot of code. With all of the workbook/worksheet manipulations going on, you may have to live with the slowness; operations writing to cells are much slower than read ops. You may want to do some crude profiling of various segments of your code to see where the greatest time is spent and concentrate on tweaking those portions. Here is some simple code I use for this purpose:

Public StartTime As Single

Public Sub StartTimer()
  StartTime = Timer
End Sub

Public Sub EndTimer()
Dim EndTime As Single
Dim Duration As Single
  EndTime = Timer
  Duration = EndTime - StartTime
  MsgBox "Elapsed Time is " & Format(Duration, "####.00") & " seconds", vbInformation + vbOKOnly, "Timer"
End Sub

Place the StartTimer and EndTimer calls at strategic locations in your code then run your procedures.

HTH
Mike

 

[rmikesmith]

To all following this, my second post was in response to a follow-up question by LinuxGuy that was started in a new thread: thread707-415079

Regards,
Mike

 

[alibongo]

Mike,

Cheers for the advice I will try this to see if it helps me shorten (tidy up) my code --- much needed.

Thanks, Alistair