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:Neon:Desktop: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:Neon:Desktop: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


"Joel" wrote:

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