PDA

View Full Version : Macro to choose Specific Workbook from a directory



ramez75
10-06-2008, 06:50 AM
Hi

Apologize if the title doesnt make sense.
I have a directory with a number of Workbook all have the same name format based on the month and year (MMYYYY). Example 112007, 122007, 012008, etc. Each Workbook have lots of worksheet and they are numbered in sequential order based on the month too and year too. Example for the month of November 2007 the worksheets are numbered as follows 1107-1, 1107-2, 1107-3, etc. And they are color coded based on five colors. Each worksheet have a list with 5 options and when you choose one then the tab color will change.

I have within the same directory a Main workbook. What I want to do is modify the macro in the main workbook to have the capability to give you the option to choose which Workbook you want to work on. At this point the macro will go through all the workbooks which ofcourse I am sometime interested on in a specific month. So how or what can I add to the macro so that I get an option to choose which Workbook i am interested in analyzing.

I know that I can use an if condition of maybe a case condition.

Example using the CASE condition with having something pop up when I run the macro and an input box comes up if I type "1" the macro will go through all the workbooks and if I type "2" then another input box will come up asking which workbook name I want to analyse.

Is that something possible?

The other thing that I wasnt successful is counting the colored tabs (worksheets) in each workbook from the Main Workbook. I have a function in each workbook that works within each workbook. But I have a lot of Workbooks and would like to be able to have the result of the functions from each workbook onto the Main Workbook. I just dont know how to get around that

Any help is greatly appreciated

RB

Bob Phillips
10-06-2008, 07:52 AM
I would suggest you so a FileDialog



Dim Filename As String
Dim wb As Workbook

ChDrive "C:\test"
ChDir "C:\test"
With Application.FileDialog(msoFileDialogOpen)

.AllowMultiSelect = False
.InitialFileName = "*.xls"
If .Show = -1 Then

Filename = .SelectedItems(1)
Set wb = Workbooks.Open(Filename:=Filename)
End If
End With

ramez75
10-06-2008, 08:31 AM
Thanks that worked.

I was using Application.GetOpenFilename......

For the second part do you know how to count the colored worksheet from main Workbook.

I am using the below function


Public Function CountOfTabColour(Colour As XlColorIndex) As Variant
Dim objSheet As Object
Dim lngCount As Long

On Error GoTo ErrCountOfTabColour

For Each objSheet In ActiveWorkbook.Sheets
If objSheet.Tab.ColorIndex = Colour Then lngCount = lngCount + 1
Next
CountOfTabColour = lngCount
Exit Function

ErrCountOfTabColour:
CountOfTabColour = CVErr(XlCVError.xlErrValue)
Exit Function

End Function

It works fine if I have it within each workbook. The downfall is that I have to open each work book and have Sheet1 assigned to give me the result.

I was trying to incorporate the Function into the Main workbook. So each time I choose one of the Workbook I call the function and get the results.

But I cant get it to work.

Unless my approach is wrong and I cant use a function and need to write a separate Macro.

Kenneth Hobs
10-06-2008, 08:49 AM
Are you wanting to run it from another workbook? If so, then open the master document and use Application.Run or put it in your Personal.xls.

If you just want to put a result in your master workbook then:
Sub Test()
Dim Filename As String
Dim wb As Workbook
Dim masterWB As Workbook
Set masterWB = ThisWorkbook

With Application.FileDialog(msoFileDialogOpen)
.AllowMultiSelect = False
.InitialFileName = "x:\*.xls"
If .Show = -1 Then
Filename = .SelectedItems(1)
Set wb = Workbooks.Open(Filename:=Filename)
End If
End With

masterWB.Worksheets(1).Range("A1").Value = wb.FullName
masterWB.Worksheets(1).Range("B1").Value = CountOfTabColour(3)

wb.Close
End Sub

ramez75
10-06-2008, 09:18 AM
No I want the result in my Master/Main Workbook. So in that case if I understand corretly I will add the below lines to my module in the Master/Main Workbook.


masterWB.Worksheets(1).Range("A1").Value = wb.FullName
masterWB.Worksheets(1).Range("B1").Value = CountOfTabColour(3)
So doing so I will have to keep the FUNCTION within each workbook and keep sheet1 in each workbook. I was trying to eliminate the use of sheet1 and make my Master/Main workbook go into the user defined workbook and give a summary on the tab color within the worksheet of the Master/Main workbook

Kenneth Hobs
10-06-2008, 10:27 AM
I do not understand what you mean by Sheet1. Your function goes through all the sheets in the activeworkbook. The master workbook's Test() would open the workbook selected in the file dialog.

You can't just use the two lines of code that I posted. You will need to Dim masterWB and Set it as I did.

You would probably want to set the values in the master workbook to the next empty row in a column on sheet1 or whatever sheet you want to store the results. As it would appear that you may want to do more than 1 workbook. If that is the case, you need to use a routine to select many workbooks or a whole folder of workbooks to batch process.

Your master workbook is where you play Test() from. It should contain your Function. So, it need not be in any of the selected workbooks.

ramez75
10-06-2008, 11:15 AM
I figured it out. What I meant by Sheet1 was that in my Main/Master Workbook. I have Sheet1 assigned as a Summary Sheet. What that means is when I run the Macro from within Master/Main Workbook (Sheet1) the macro will go into all other workbook in the directory or through a specific workbook and will extract specific data based on the IF CONDITIONS within the macro. One of the things I needed in my summary report is to produce a table with the number of how many tabs are RED or BLUE or GREEN colored from each workbook separately. At first I had the FUNCTION statement embedded within each workbook and had assinged the first Worksheet of each workbook to produce that table. Since i have lots of Workbooks within the directory it was becoming a hassle since I need to open each workbook to view that table.

So what I was trying to do is to access those results from my Master/ Main workbook. Below how I ended up doing it and dont need the FUNCTION statement anymore



If Filename <> ThisWB Then
For i = 1 To Sheets.Count
If Sheets(i).Visible = True Then ' Exclude hidden sheets
Sheets(i).Select
Set ws = Sheets(i) ' Set Opened Worksheet as the working Worksheet
If ws.Name = "Create New NCR Form" Then GoTo NextSheet
If ws.Range("C3") = "" Then
ws.Range("O10").Copy Destination:=Main.Sheets("NCR Disposition Type Report").Cells(Destrow, 7)
ws.Range("O17").Copy Destination:=Main.Sheets("NCR Disposition Type Report").Cells(Destrow, 8)
ws.Range("L28").Copy Destination:=Main.Sheets("NCR Disposition Type Report").Cells(Destrow, 9)
' Delete comments inherited from the NCR form
Main.Sheets("NCR Disposition Type Report").Cells(Destrow, 9).Comment.Delete
' Increment destination row
Destrow = Destrow + 1
End If
If ws.Range("L28") <> "" Then ' Count tabs based on type of disposition
If ws.Range("L28") = "Reclaim" Then
k = k + 1
ElseIf ws.Range("L28") = "Repack" Then
l = l + 1
ElseIf ws.Range("L28") = "Scrap" Then
s = s + 1
ElseIf ws.Range("L28") = "Other" Then
o = o + 1
ElseIf ws.Range("L28") = "Release" Then
m = m + 1
ElseIf ws.Range("L28") = "Rework" Then
n = n + 1
End If
End If
End If

NextSheet:
Next i
Wkb.Close False
End If

End With

Main.Sheets("NCR Disposition Type Report").Range("E4").Value = k
Main.Sheets("NCR Disposition Type Report").Range("E6").Value = l
Main.Sheets("NCR Disposition Type Report").Range("E3").Value = s
Main.Sheets("NCR Disposition Type Report").Range("E8").Value = o
Main.Sheets("NCR Disposition Type Report").Range("E5").Value = m
Main.Sheets("NCR Disposition Type Report").Range("E7").Value = n



Might not be the best way to do it. But if there is better way to Optimize the code I am very much open to suggestion. I will try to use the CASE COndition but didnt figure it out yet