Collect Info from Wkbks in a Folder with Criteria to 1 sheet. CHAL

[Neon520]

Hi Everyone,

Here is what want to do:
I need to collection information with X amounts of sheet in one particular
folder that meet a particular criteria (let's say find all those line/records
that are December in a certain column range) and then store all of those
information in one Sheet name Summary).

Basically what I want is a summary sheet of all the workbooks in on folder.
I did a little research in the Discussion group, but mostly are just
collecting ALL data in workbooks and put them in one workbook in different
sheet. However, for my purpose, I also need the Macro/Program to search for
Certain Criteria before copying the Line over and Pending to ONE sheet only.

Is it possible to do this?

THANK YOU FOR ANY SUGGESTION/ADVISE.
Neon520

 

[Joel]

Try something like this

Sub GetData()

Set NewSht = ThisWorkbook.ActiveSheet

Folder = "c:\temp\"
FName = Dir(Folder & "*.xls")
NewRowCount = 1
Do While FName <> ""
Set OldBk = Workbooks.Open(Filename:=Folder & FName)
For Each Sht In OldBk.Sheets
With Sht
OldRowCount = 1
Do While .Range("A" & OldRowCount) <> ""
If .Range("A" & OldRowCount) = "December" Then
.Rows(OldRowCount).Copy _
Destination:= NewSht.Rows(NewRowCount)
NewRowCount = NewRowCount + 1
End If
OldRowCount = OldRowCount + 1
Loop
End With
Next Sht
OldBk.Close savechanges:=False
FName = Dir()
Loop

End Sub

 

[Neon520]

Hi Joel,

Thank you for your reply, and I'm sorry to bother you again.
But I tried your code several times/ways, it didn't work out for me.

Here is the modified code I use for myself:

Sub Transfer()
'
' Transfer Macro
'
' Keyboard Shortcut: Option+Cmd+x
'

Set NewSht = ThisWorkbook.ActiveSheet

Folder = "/Users/Neon/Desktop/TEST FOLDER"
FName = Dir(Folder & "Workbook1.xls")
NewRowCount = 1
Do While FName <> ""
Set OldBk = Workbooks.Open(Filename:=Folder & FName)
For Each Sht In OldBk.Sheets
With Sht
OldRowCount = 1
Do While .Range("B" & OldRowCount) <> ""
If .Range("B" & OldRowCount) = "December" Then
..Rows(OldRowCount).Copy _
Destination:=NewSht.Rows(NewRowCount)
NewRowCount = NewRowCount + 1
End If
OldRowCount = OldRowCount + 1
Loop
End With
Next Sht
OldBk.Close savechanges:=False
FName = Dir()
Loop

End Sub

First of all, I'm a Mac user so the file/folder directory is a little
different from PC. Second of all I only change File name to Workbook1.xls (I
also tried it with the * on it, not work). Thirdly, I changed the column "A"
to "B".

Can you tell what I did wrong here? I place everything in a folder called
TEST FOLDER on the desktop.

Thank you,
Neon520

 

[Joel]

You lost the last slash on the folder name. My code has one and yours doesn't.

 

[Neon520]

Hi Joel,

Sorry to bother you Again!

But it still doesn't work for whatever reason.

I tried the keyboard shortcut that I assign and then I tried to go to Macro
and run it from there, but nothing. When I did the keyboard shortcut, the
screen just had a slight flick, and then nothing happen - no data transfer,
no change in appearance, nothing.

Any idea that I can try?

Thanks for your help.
Neon520

 

[Joel]

I added some msgbox for debugging. Also change the check for December to
ignore case. One possibility in the Month is a serial date like 12/16/08
which is formated to display the Month only.

then the check would be
If Month(.Range("B" & OldRowCount)) = 12 Then



Sub Transfer()
'
' Transfer Macro
'
' Keyboard Shortcut: Option+Cmd+x
'

Set NewSht = ThisWorkbook.ActiveSheet

Folder = "/Users/Neon/Desktop/TEST FOLDER/"
FName = Dir(Folder & "*.xls")
MsgBox ("Found file : " & FName)
NewRowCount = 1
Do While FName <> ""
Set OldBk = Workbooks.Open(Filename:=Folder & FName)
For Each Sht In OldBk.Sheets
MsgBox ("check Sheet : " & Sht.Name)
With Sht
OldRowCount = 1
Do While .Range("B" & OldRowCount) <> ""
If UCase(.Range("B" & OldRowCount)) = "DECEMBER" Then
..Rows(OldRowCount).Copy _
Destination:=NewSht.Rows(NewRowCount)
NewRowCount = NewRowCount + 1
End If
OldRowCount = OldRowCount + 1
Loop
End With
Next Sht
OldBk.Close savechanges:=False
FName = Dir()
MsgBox ("Found file : " & FName)
Loop

End Sub

 

[Neon520]

THANK YOU SO MUCH, JOEL! I can never say thank you enough!

You know what I found out? Remember I told you that I'm on a Mac. I did a
little google search and found out that file directory is written in : not /
or \ on a Mac! I changed that and voila, it works!

Now, if you don't mind, I would like to ask you a few more questions to get
it to work the way I need.
1. Can I grab the data in other workbooks without open them? My concern is
if the user make changes to Workbook1 and didn't save and close it, there
will be debugging error.
2. Can you modify the code so that it will check ALL workbooks in a
Particular Folder (TEST FOLDER) regardless of names? I tried FName =
Dir(Folder & "*.xls"), but it didn't work. It only worked when I put in
Workbook1.xls.
3. Is there a way to select Particular Cell/row/column OR starting at
particular cell/row in Workbook1, instead of checking the whole column?
4. Is there a way to place the data that has been picked in a Particular
cell/row instead of starting in A1?

Lastly, Is this a "good" setup for my purpose of having a summary sheet to
work on? I don't want to place all Account in one giant workbook with 20+
sheets and one summary sheet. That's why I want to create one workbook for
each account and have this code that will collect a particular information to
a separate summary workbook. If in case of file lost of data corruption, not
all eggs are in one basket. Do you think that this is a good strategy? Or
is there a better way to do this?

THANK YOU SOOO MUCH FOR YOUR HELP, JOEL.
Neon520

 

[Joel]

See responses below

THANK YOU SO MUCH, JOEL! I can never say thank you enough!

You know what I found out? Remember I told you that I'm on a Mac. I did a
little google search and found out that file directory is written in : not /
or \ on a Mac! I changed that and voila, it works!

Now, if you don't mind, I would like to ask you a few more questions to get
it to work the way I need.
1. Can I grab the data in other workbooks without open them? My concern is
if the user make changes to Workbook1 and didn't save and close it, there
will be debugging error.

There is a method reading workbooks without opening them using database
commands (excel and access files use similar methods of storing data) but I
would think using the not opening a file will give the same errors.

2. Can you modify the code so that it will check ALL workbooks in a
Particular Folder (TEST FOLDER) regardless of names? I tried FName =
Dir(Folder & "*.xls"), but it didn't work. It only worked when I put in
Workbook1.xls.

Using my debug msgbox messages was anythiing returned when you used the
wildcard. Haven't used Macs very often and im not familar with the wildcard
in Mac. Thought it was a *. Look more into Macs using the DIR() command and
see if you can find out how to use a wildcard.

3. Is there a way to select Particular Cell/row/column OR starting at
particular cell/row in Workbook1, instead of checking the whole column?

The start row is controlled by this statement

OldRowCount = 1

Depending on the number of columns you want copied there are different
methods of selecting columns. You can always delete columns after the code
is run

you can use this change

from
If UCase(.Range("B" & OldRowCount)) = "DECEMBER" Then
.Rows(OldRowCount).Copy _
Destination:=NewSht.Rows(NewRowCount)
NewRowCount = NewRowCount + 1
End If

to

If UCase(.Range("B" & OldRowCount)) = "DECEMBER" Then
NewSht.Range("A" & Newrowcount) = .Range("C" & Oldrowcount)
NewSht.Range("B" & Newrowcount) = .Range("F" & Oldrowcount)
NewSht.Range("C" & Newrowcount) = .Range("K" & Oldrowcount)
NewSht.Range("D" & Newrowcount) = .Range("O" & Oldrowcount)

NewRowCount = NewRowCount + 1
End If

4. Is there a way to place the data that has been picked in a Particular
cell/row instead of starting in A1?

Newrowcount sets where the the 1st row where the data is copied to.

NewRowCount = 1

 

[Neon520]

Hi Joel,

I have a few more questions for you if you don't mind my low level of
programming experience.

Is there a way to specify the column? It’s in the case that I need to
transfer from Old worksheet Column A to New worksheet Column B instead?
Basically not everything comes in a column-by-column order; Old Column B can
be transferred to Column D instead. So it’s varied. And it’s only for
particular column, not all of them.

What do I have to do if I need to copy the “Value†ONLY because there are
formulas in the New sheet already for other calculation? I don't want to
copy the Format of the cells along with them.

I know that we "HARD CODE" the criteria of searching for a particular month
before copying the data, can we somehow "SOFT CODE" it instead?
Like I said earlier, I'm a newbie in this programming for excel, one dummy
trick that I always use is pointing it to a particular cell - the cell that
formatted to be a drop down list of all 12 months - so that user can select a
particular month that they need to do a summary sheet of. I'm hopping to do
that and implement a BUTTON that is link with the code, so that the user can
select the month and then press the button to execute. What do you think?

THANK YOU SO MUCH FOR ALL OF YOUR PREVIOUS ANSWERS!!!!

Neon520

 

[Joel]

The code below copies only the values and not the formulas or formating. the
code also copies from one column to any other column.

If UCase(.Range("B" & OldRowCount)) = "DECEMBER" Then
NewSht.Range("A" & Newrowcount) = .Range("C" & Oldrowcount)
NewSht.Range("B" & Newrowcount) = .Range("F" & Oldrowcount)
NewSht.Range("C" & Newrowcount) = .Range("K" & Oldrowcount)
NewSht.Range("D" & Newrowcount) = .Range("O" & Oldrowcount)

NewRowCount = NewRowCount + 1
End If

You can also use PasteSpecial to copy just the values


Range("A1:A20").Copy
Range("D1").PasteSpecial Paste:=xlPasteValues


Using the Copy method copies the formating as well as the data

.Rows(OldRowCount).Copy _
Destination:=NewSht.Rows(NewRowCount)


The code below I changed December from hard coded to soft coded by assigning
the month to a variable. "December" is a string because it has double quotes
around the month name. You can assign the month to a variable as shown
below. You can also copy the month from an input box as shown below

method 1
MyMonth = Inputbox("enter name of month : ")

method 2
Mymonth = "December"

here is method 2 in the code below



Sub Transfer()
'
' Transfer Macro
'
' Keyboard Shortcut: Option+Cmd+x
'

Mymonth = "DECEMBER"

Set NewSht = ThisWorkbook.ActiveSheet

Folder = "/Users/Neon/Desktop/TEST FOLDER/"
FName = Dir(Folder & "*.xls")
MsgBox ("Found file : " & FName)
NewRowCount = 1
Do While FName <> ""
Set OldBk = Workbooks.Open(Filename:=Folder & FName)
For Each Sht In OldBk.Sheets
MsgBox ("check Sheet : " & Sht.Name)
With Sht
OldRowCount = 1
Do While .Range("B" & OldRowCount) <> ""
If UCase(.Range("B" & OldRowCount)) = Mymonth Then
..Rows(OldRowCount).Copy _
Destination:=NewSht.Rows(NewRowCount)
NewRowCount = NewRowCount + 1
End If
OldRowCount = OldRowCount + 1
Loop
End With
Next Sht
OldBk.Close savechanges:=False
FName = Dir()
MsgBox ("Found file : " & FName)
Loop

End Sub

 

[Neon520]

Hi Joel,

I don't seem to have any luck with the PasteSpecial code that you gave me at
all, which is the one that I really need. I was able to work out with the ...
NewSht.Range("A" & Newrowcount) = .Range("C" & Oldrowcount) fine.

I tried:
Range("A10:A20").Copy
Range("D1020").PasteSpecial Paste:=xlPasteValues
but the screen just flash a few times, and nothing copied/transferred over.
What went wrong?
And I'm just curious about the code that where is it that specify to Copy
from the Old wkbk and paste to a New wkbk?

btw, Do you have any idea why UCase is not working properly in my case?
Supposedly, it's the code to eliminate case sensitive by converting
everything to UPPERCASE, right? But in my test, when I put in all lower case
letters, nothing transfer, versus when I put in all UPPERCASE letters, it
works fine.

Can you change the code from Inputbox("enter name of month: ") to a
DropDownList instead, cause I think this way it will reduce user input error
(ie typo) that will result in any errors?

Thank you,
Neon520

 

[Neon520]

What is the code to clear out ALL the data in the sheet before running the
code?

What I notice is if I run the code once for JANUARY, and let's say there are
5 lines came up, and IF I run the code again for FEBUARY and there are only
2 lines for FEB, the last 3 lines for JANUARY that was mistakenly created was
still there, so is there a way to clear everything out first before running
the code?

Thanks,
Neon520

 

[Joel]

The next time you ask for some changes can you please post your lasted code.
We are working with two different postings (the one Where I added the MACID
and this one). It is easier for me to correct the version of the code you
are using then a bastardized version.

If this worked
NewSht.Range("A" & Newrowcount) = .Range("C" & Oldrowcount) fine.

Then this should work
..Range("A10:A20").Copy
NewSht.Range("D1020").PasteSpecial Paste:=xlPasteValues


The period is required to reference the old sheet and NEWSHT is required to
reference the new sheet. Without the period and NewSht excel isn't getting
the source and destination sheets correct


To clear sheet

from
Set NewSht = ThisWorkbook.ActiveSheet

to
Set NewSht = ThisWorkbook.ActiveSheet
NewSht.Cells.ClearContents


It would be beeter in you code rather than use this line
Set NewSht = ThisWorkbook.ActiveSheet

To give the starting sheet a name like

Set NewSht = ThisWorkbook.Sheets("Sheet1") or use the sheet name on the tab
at the bottom of the worksheet. Using the Activesheet is prone to errors if
the person doesn't select the correct worksheet.

 

[Neon520]

I apologize for this confusion, Joel.

Here is the current that I'm working on right now:

Sub Transfer()

' Transfer Macro

' Keyboard Shortcut: Option+Cmd+x

' Method 1 - Using InputBox
'Mymonth = InputBox("Enter Name of Month (ALL CAPS): ")

' Method 2 - Reference to a Particular cell; the cell can be formatted to
dropdownlist
'to reduce user input error
Mymonth = Range("A1")

Set NewSht = ThisWorkbook.ActiveSheet
NewSht.Range("A230").ClearContents

Folder = "Users:Neonesktop:TEST FOLDER:"
FName = Dir(Folder, MacID("XLS8"))

MsgBox ("Found file:" & FName)
Newrowcount = 2
Do While FName <> ""
Set OldBk = Workbooks.Open(Filename:=Folder & FName)
For Each Sht In OldBk.Sheets
'MsgBox ("check Sheet : " & Sht.Name)
With Sht
Oldrowcount = 7
Do While .Range("B" & Oldrowcount) <> ""
If UCase(.Range("B" & Oldrowcount)) = Mymonth Then

' Method 1 - Copy everything
' .Rows(Oldrowcount).Copy _
' Destination:=NewSht.Rows(Newrowcount)

' Method 2 Paste Special
.Range("B7:B31").Copy
NewSht.Range("D2").PasteSpecial Paste:=xlPasteValues

' Method 3 Copy and Paste Column by Column
'NewSht.Range("A" & Newrowcount) = .Range("A" & Oldrowcount).Value
'NewSht.Range("B" & Newrowcount) = .Range("B" & Oldrowcount).Value
'NewSht.Range("C" & Newrowcount) = .Range("C" & Oldrowcount).Value
'NewSht.Range("D" & Newrowcount) = .Range("D" & Oldrowcount).Value

Newrowcount = Newrowcount + 1
End If
Oldrowcount = Oldrowcount + 1
Loop
End With
Next Sht
OldBk.Close savechanges:=False
FName = Dir()
'MsgBox ("Found file : " & FName)
Loop

End Sub

PROBLEMS:
1. When using the paste special codes, the Criteria that >>If
UCase(.Range("B" & Oldrowcount)) = Mymonth Then<< doesn't seem to take
effect, because it just copy the column "B7:B31" without filtering the month.


QUESTIONS:
1. Can you set a filter mechanism so that if ANY files in TEST FOLDER is
opened, there will be a message prompted the user to save and/or close the
files Before proceed with transferring data?
Something like this, maybe:
Open File to Extract data,
If Files in TEST FOLDER is opened,
then show message: "<ALL files name> is open, please close all files in
TEST FOLDER before proceed."

2. Is there a way to let the user Browse to find the TEST FOLDER in case
TEST FOLDER has been renamed or moved to a different location? (since you
hardcode the TEST FOLDER in the code)

3. Is there a way to eliminate the "FLASH SCREEN" when the code is run? Is
it a good idea to disable the flash screen?

More questions to come, if you don't feel bored with all my nonsense
questions.

I appreciate for all your help to me with this project.

Neon520

 

[Joel]

Ask as many questions as necessary. I like teaching. I answered the
questions below.

PROBLEMS:
1. When using the paste special codes, the Criteria that >>If
UCase(.Range("B" & Oldrowcount)) = Mymonth Then<< doesn't seem to take
effect, because it just copy the column "B7:B31" without filtering the month.

from
' Method 2 Paste Special
.Range("B7:B31").Copy
NewSht.Range("D2").PasteSpecial Paste:=xlPasteValues

to

' Method 2 Paste Special
.Range("B" & Oldrowcount ).Copy
NewSht.Range("A" & Newrowcount).PasteSpecial Paste:=xlPasteValues

or

' Method 2 Paste Special
.Range("A" & Oldrowcount & "" & Oldrowcount).Copy
NewSht.Range("D" & Newrowcount).PasteSpecial Paste:=xlPasteValues

Note: We are copying columns A-D so the results will go into columns D-G.
You only have to specify the 1st location of the range. Excel will match the
size of the source and automatically calculate the size of destination just
like in the worksheet. You can specifically specify the size of the
destination but if the source and destination are not the same size an error
will occur. The code below will work also.

' Method 2 Paste Special
.Range("A" & Oldrowcount & "" & Oldrowcount).Copy
NewSht.Range("D" & Newrowcount & ":G" & Newrowcount).PasteSpecial
Paste:=xlPasteValues


QUESTIONS:
1. Can you set a filter mechanism so that if ANY files in TEST FOLDER is
opened, there will be a message prompted the user to save and/or close the
files Before proceed with transferring data?
Something like this, maybe:
Open File to Extract data,
If Files in TEST FOLDER is opened,
then show message: "<ALL files name> is open, please close all files in
TEST FOLDER before proceed."

Here is code I found posted by Tom Ogilvy

On error resume next
set bk = workbooks("MyBook.xls")
On error goto 0
if not bk is nothing then
msgbox "MyBook.xls is already open in excel"
else
msgbox "MyBook.xls is not open"
End if




2. Is there a way to let the user Browse to find the TEST FOLDER in case
TEST FOLDER has been renamed or moved to a different location? (since you
hardcode the TEST FOLDER in the code)

With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = "C:\"
If .Show = -1 Then
Folder = .SelectedItems(1)
Else
MsgBox ("Cannot open folder - Exiting Macro")
Exit Sub
End If
End With

MsgBox ("The selected folder is : " & Folder)


Note: the slash at the end of the Folder is missing. You need to add it in
to use the rest of you macro

3. Is there a way to eliminate the "FLASH SCREEN" when the code is run? Is
it a good idea to disable the flash screen?

You can can add to the beginning and end of the code. the macro will run
faster when you disable the ScreenUpdating.

'at beginning of code
Application.ScreenUpdating = False
'at end of code
Application.ScreenUpdating = True


Here is the results of the above changes

Sub Transfer()

' Transfer Macro

' Keyboard Shortcut: Option+Cmd+x

Application.ScreenUpdating = False

' Method 1 - Using InputBox
'Mymonth = InputBox("Enter Name of Month (ALL CAPS): ")

' Method 2 - Reference to a Particular cell; the cell can be formatted to
dropdownlist
'to reduce user input error
Mymonth = Range("A1")

Set NewSht = ThisWorkbook.ActiveSheet
NewSht.Range("A230").ClearContents

Folder = "Users:Neonesktop:TEST FOLDER:"
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = "C:\"
If .Show = -1 Then
Folder = .SelectedItems(1)
Else
MsgBox ("Cannot open folder - Exiting Macro")
Exit Sub
End If
End With

MsgBox ("The selected folder is : " & Folder)

'check if any files are opened
FName = Dir(Folder, MacID("XLS8"))
Do while FName <> ""
MsgBox ("Found file:" & FName)

On error resume next
set bk = workbooks(FName)
On error goto 0
if not bk is nothing then
msgbox("save and/or close the files Before proceed with transferring
data")
msgbox("Exiting Macro")
Application.ScreenUpdating = True
exit sub
End if

FName = Dir()
loop


'Start DIR again from first file
FName = Dir(Folder, MacID("XLS8"))

Newrowcount = 2
Do While FName <> ""
Set OldBk = Workbooks.Open(Filename:=Folder & FName)
For Each Sht In OldBk.Sheets
'MsgBox ("check Sheet : " & Sht.Name)
With Sht
Oldrowcount = 7
Do While .Range("B" & Oldrowcount) <> ""
If UCase(.Range("B" & Oldrowcount)) = Mymonth Then

' Method 1 - Copy everything
' .Rows(Oldrowcount).Copy _
' Destination:=NewSht.Rows(Newrowcount)

' Method 2 Paste Special
.Range("B" & Oldrowcount ).Copy
NewSht.Range("A" & Newrowcount).PasteSpecial Paste:=xlPasteValues

' Method 3 Copy and Paste Column by Column
'NewSht.Range("A" & Newrowcount) = .Range("A" & Oldrowcount).Value
'NewSht.Range("B" & Newrowcount) = .Range("B" & Oldrowcount).Value
'NewSht.Range("C" & Newrowcount) = .Range("C" & Oldrowcount).Value
'NewSht.Range("D" & Newrowcount) = .Range("D" & Oldrowcount).Value

Newrowcount = Newrowcount + 1
End If
Oldrowcount = Oldrowcount + 1
Loop
End With
Next Sht
OldBk.Close savechanges:=False
FName = Dir()
'MsgBox ("Found file : " & FName)
Loop

Application.ScreenUpdating = True

End Sub

 

[Neon520]

Hi Joel,
I'm glad to hear that you don't mind about the quesitons.

I tested the codes.
The Application.ScreenUpdating = False/True works great. But the other two
doesn't.

PROBLEMS:
CODE: With Application.FileDialog(msoFileDialogFolderPicker)
ERRROR MESSAGE: Run-time error ‘438’:
Object doesn’t support this property or method

CODE: set bk = workbooks(FName)
ERROR MESSAGE: Run-time error ‘424’
Object required

As you can see that I modified Mymonth to: Mymonth = Range("A1"), so that I
can mickeymouse the cell as dropdown list of JAN-DEC so that I can eliminate
the occassion user typo, and also the fact that I don't know how to code a
dropdown list of the popup message box instead of InputBox. However, I notice
that even with A1 is left blank the code is still running fine, which seem a
little illogical to me.

Can you modify the code so that If A1 is Null/Blank > A message box pop up
to let the user select a month before proceeding?

If you don't mind I would love to ask you for another Big Big favor. I have
posted another thread that is related to the project that I'm doing here,
except the goal is slightly different than this one. The title of the thread
is LATE FEE RECONCILIATION – HELP!!
I've posted it since yesterday and I haven't seen any response from anyone
yet. Not sure if it's the holiday crunch time kick in or if there's no
anyone up to the challenge there.
If you have the time and don't mind saving me again, please, please take a
look at that.

THANK YOU SOOOO MUCH.
Neon520

 

[Joel]

I got an e-mail today indicating there was a new posting, yet when I looked
there is no message.

 

[Neon520]

I'm not sure if it's the glitch from Microsoft side or not, but when I'm
coming to the forum for several times to check back and see if you reply or
not yet. Some I saw that it's 16 posts (which is right) sometime I saw only
15.

Just in case, I repost my previous post again. Here it is:

Hi Joel,
I'm glad to hear that you don't mind about the quesitons.

I tested the codes.
The Application.ScreenUpdating = False/True works great. But the other two
doesn't.

PROBLEMS:
CODE: With Application.FileDialog(msoFileDialogFolderPicker)
ERRROR MESSAGE: Run-time error ‘438’:
Object doesn’t support this property or method

CODE: set bk = workbooks(FName)
ERROR MESSAGE: Run-time error ‘424’
Object required

REQUEST:
If UCase(.Range("B" & Oldrowcount)) = Mymonth Then
The above code will match/filter the column B and Mymonth cell, right? What
if I need to filter by date instead? Let's say I need to filter any line
that is later than 02/01/08 (let's say the date is still in Mymonth cell).
What is the most practical way to do this? I tried changing the Mymonth cell
to a date and the equal sign to a > or < sign but it doesn't seem to work at
all. Is it tricky to deal with DATE in Excel? What is the best way to set
this up so that user can do a query of < or > or = to the DATE according to
their need?

As you can see that I modified Mymonth to: Mymonth = Range("A1"), so that I
can mickeymouse the cell as dropdown list of JAN-DEC so that I can eliminate
the occassion user typo, and also the fact that I don't know how to code a
dropdown list of the popup message box instead of InputBox. However, I notice
that even with A1 is left blank the code is still running fine, which seem a
little illogical to me.

Can you modify the code so that If A1 is Null/Blank > A message box pop up
to let the user select a month before proceeding?

If you don't mind I would love to ask you for another Big Big favor. I have
posted another thread that is related to the project that I'm doing here,
except the goal is slightly different than this one. The title of the thread
is LATE FEE RECONCILIATION – HELP!!
I've posted it since yesterday and I haven't seen any response from anyone
yet. Not sure if it's the holiday crunch time kick in or if there's no
anyone up to the challenge there.
If you have the time and don't mind saving me again, please, please take a
look at that.

THANK YOU SOOOO MUCH.
Neon520

I also notice that if the post is tooooo long, then there will be a second
page for the post. There will be a "more..." button at the bottom of the
page.

 

[Joel]

This website has been down since the evening of the 23rd. Just came back up
this morning

I tried this code below on my maching and it works perfectly. Probably a
problem using a MAC. Try changing the Path name "C:\" and see if it works.
If it fails on the WITH line then MAC isn't recognizing the Library. On my
PC in the VBA window there is a manu option TOOLS - REFERENCES where you can
specify the libraries. I use the following options

1) visual Basic for Applications
2) Microsoft Excel 10.0 Object Library
3) OLE automation
4) Microsoft Office 10.0 Object Library




Sub test()

With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = "C:\"
If .Show = -1 Then
Folder = .SelectedItems(1)
Else
MsgBox ("Cannot open folder - Exiting Macro")
Exit Sub
End If
End With

MsgBox ("The selected folder is : " & Folder)

End Sub

----------------------------------------------------------------------------
The line below doesn't create an error message on a PC like on the MAC if
the workbook isn't opened. The ON ERROR statement allows the code to
continue.

set bk = workbooks(FName)

-------------------------------------------------------------------------

to filter by a date use need to use datavalue to convert an ascii date to a
serialdate. A serial date is a date which 1 = Jan 1, 1900 and increments by
one for each DAY. Dec 29, 2008 = 39811

An Hour is represented by 1/24 starting at midnight so noon is .5, 6:00 AM =
..25, ^:00 PM is .75.

So to filter on after 02/01/08 is this

if MyDay >= DateValue("02/01/08") then

end if



----------------------------------------------------------

Test if A1 is blank

Mymonth = Range("A1")
Do while MyMonth = ""
Mymonth = InputBox("Enter Name of Month (ALL CAPS): ")
loop

 

[Neon520]

Hi Joel.

Great to hear from you back!
I guess I should forget about FileDialogFolderPicker, since it might not be
supported by Mac OS.
I think it's a matter of training the user NOT to move the specified folder
around should avoid the problem after all. Thanks for the effort though.

I'd like to put up a message box in case that there is no match for the
Month in A1 to anything in the column B in all other files. I tried two
different way with If... ElseIf... End If, but not successful. Can you tell
me what's wrong?

1ST ATTEMPT
Sub Transfer()

' Transfer Macro

' Keyboard Shortcut: Option+Cmd+x

Application.ScreenUpdating = False

Mymonth = Range("A1")
Do While Mymonth = ""
Answer = MsgBox("Enter Name of Month (ALL CAPS)", vbOKOnly)
If Answer = vbOK Then Exit Sub
Loop

Set NewSht = ThisWorkbook.ActiveSheet
'Clear the Content Below, so if user Cancel, the old info is still exist.
'NewSht.Range("A2:E100").ClearContents
'NewSht.Range("G2:G100").ClearContents

Folder = "Users:Neonesktop:TEST FOLDER:"
FName = Dir(Folder, MacID("XLS8"))


Answer = MsgBox("Found files: " & FName & ". Would you like to proceed?",
vbOKCancel)
If Answer = vbCancel Then Exit Sub

NewSht.Range("A2:E100").ClearContents
NewSht.Range("G2:G100").ClearContents

Newrowcount = 2
Do While FName <> ""
Set OldBk = Workbooks.Open(Filename:=Folder & FName)
For Each Sht In OldBk.Sheets
'MsgBox ("check Sheet : " & Sht.Name)
With Sht
Oldrowcount = 7
' Attempt to change from Range B to A for searching by "greater than A"
Do While .Range("B" & Oldrowcount) <> ""

'If Not Match, Show the Message Box.
If UCase(.Range("B" & Oldrowcount)) <> Mymonth Then
Answer = MsgBox("There is no information match your specified query.",
vbOKOnly)
If Answer = vbOK Then Exit Sub

OldBk.Close savechanges:=False
FName = Dir()

'If Match, copy to New Sheet
ElseIf UCase(.Range("B" & Oldrowcount)) = Mymonth Then

.Range("A" & Oldrowcount).Copy
NewSht.Range("A" & Newrowcount).PasteSpecial Paste:=xlPasteValues
.Range("C" & Oldrowcount).Copy
NewSht.Range("D" & Newrowcount).PasteSpecial Paste:=xlPasteValues
.Range("D" & Oldrowcount).Copy
NewSht.Range("E" & Newrowcount).PasteSpecial Paste:=xlPasteValues
.Range("B" & Oldrowcount).Copy
NewSht.Range("G" & Newrowcount).PasteSpecial Paste:=xlPasteValues
.Range("B1").Copy
NewSht.Range("B" & Newrowcount).PasteSpecial Paste:=xlPasteValues



Newrowcount = Newrowcount + 1
End If
Oldrowcount = Oldrowcount + 1
Loop
End With
Next Sht
OldBk.Close savechanges:=False
FName = Dir()

Loop

Application.ScreenUpdating = True

End Sub


2ND ATTEMPT
Sub Transfer()

' Transfer Macro

' Keyboard Shortcut: Option+Cmd+x

Application.ScreenUpdating = False

Mymonth = Range("A1")
Do While Mymonth = ""
Answer = MsgBox("Enter Name of Month (ALL CAPS)", vbOKOnly)
If Answer = vbOK Then Exit Sub
Loop

Set NewSht = ThisWorkbook.ActiveSheet
'Clear the Content Below, so if user Cancel, the old info is still exist.
'NewSht.Range("A2:E100").ClearContents
'NewSht.Range("G2:G100").ClearContents

Folder = "Users:Neonesktop:TEST FOLDER:"
FName = Dir(Folder, MacID("XLS8"))


Answer = MsgBox("Found files: " & FName & ". Would you like to proceed?",
vbOKCancel)
If Answer = vbCancel Then Exit Sub

NewSht.Range("A2:E100").ClearContents
NewSht.Range("G2:G100").ClearContents

Newrowcount = 2
Do While FName <> ""
Set OldBk = Workbooks.Open(Filename:=Folder & FName)
For Each Sht In OldBk.Sheets
'MsgBox ("check Sheet : " & Sht.Name)
With Sht
Oldrowcount = 7
' Attempt to change from Range B to A for searching by "greater than A"
Do While .Range("B" & Oldrowcount) <> ""

'If Match, copy to New Sheet
If UCase(.Range("B" & Oldrowcount)) = Mymonth Then

.Range("A" & Oldrowcount).Copy
NewSht.Range("A" & Newrowcount).PasteSpecial Paste:=xlPasteValues
.Range("C" & Oldrowcount).Copy
NewSht.Range("D" & Newrowcount).PasteSpecial Paste:=xlPasteValues
.Range("D" & Oldrowcount).Copy
NewSht.Range("E" & Newrowcount).PasteSpecial Paste:=xlPasteValues
.Range("B" & Oldrowcount).Copy
NewSht.Range("G" & Newrowcount).PasteSpecial Paste:=xlPasteValues
.Range("B1").Copy
NewSht.Range("B" & Newrowcount).PasteSpecial Paste:=xlPasteValues

'If Not Match, Show the Message Box.
ElseIf UCase(.Range("B" & Oldrowcount)) <> Mymonth Then
Answer = MsgBox("There is no information match your specified query.",
vbOKOnly)
If Answer = vbOK Then Exit Sub

OldBk.Close savechanges:=False
FName = Dir()



Newrowcount = Newrowcount + 1
End If
Oldrowcount = Oldrowcount + 1
Loop
End With
Next Sht
OldBk.Close savechanges:=False
FName = Dir()

Loop

Application.ScreenUpdating = True

End Sub

It always show up the MsgBox("There is no information match your specified
query.") no matter the it's = Mymonth or <>Mymonth. What did I do wrong?

ONE MORE QUESTION:
How do I write in code if I want to say:
Copy A2 in All Files in TEST FOLDER, if there is NO MATCH in Column B of
those file to A1 to the ActiveSheet.
Everything should be the same as the code that you gave me except the NO
MATCH part. I tried using <>, but it copies everything line by line from the
oldwkbks. I only need only entry per sheet if there is NO MATCH.

What is the correct code for "NOT MATCH"?

Thanks again,
Neon520