Hi David
Here is a version that includes the following.
1. Checks the data in cell A2 is valid - if not ends program
2. Checks there is an office number - if not asks user to enter number
3. Checks if the office number is in summary table - if not asks user if
they wish to add (adds after last row)
4. Allows dates to be in the range 1st to last day of month-year
5. If date out of range tell user and end program.

Hope this helps as a template, you might wish to tidy it up to suit your
needs.
'################################################# #########
Sub Transfer()
Dim wbSum As Workbook, wbData As Workbook
Set wbSum = Workbooks("Summary.xls")
Set wbData = ActiveWorkbook

' get source data from open sheet
Dim iOffice As Integer, iDate As Date, iValue
With wbData.Sheets("Sheet1")
iOffice = .Range("A1")
If IsDate(.Range("A2")) Then
iDate = .Range("A2")
Else
MsgBox "Date: " & .Range("A2") & " is not valid format", vbCritical
+ vbOKOnly, "Date Error"
Exit Sub
End If
iValue = .Range("A3")
End With
' apply values to matched row and column
With wbSum.Sheets("Sheet1")
Dim lastrow As Long, lastcol As Long, xV As Long, xR As Long, xC As Long
lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
lastcol = .Cells(1, Columns.Count).End(xlToLeft).Column
'get matching row
For xV = 2 To lastrow
If iOffice = .Cells(xV, 1) Then xR = xV
Next xV
If xR = 0 Then
' check if there is an office number
If iOffice < 1 Then
iOffice = Application.InputBox(prompt:="Enter Office Number",
Title:="No Office Number Found")
End If
If MsgBox("Office: " & iOffice & " not found in summary table" &
vbCrLf & _
"Do you want to add it to the summary table ?", vbExclamation +
vbYesNo) = vbYes Then
.Cells(lastrow + 1, 1) = iOffice
xR = lastrow + 1
End If
End If
' get matching column and date in range of month and year
For xV = 2 To lastcol
If Month(iDate) = Month(.Cells(1, xV)) And _
Year(iDate) = Year(.Cells(1, xV)) Then xC = xV
Next xV
If xC = 0 Then MsgBox "Date: " & iDate & " not found in summary table"
If xR 0 And xC 0 Then .Cells(xR, xC) = iValue

End With

End Sub
'################################################# ##########################
#

--
Cheers
Nigel



"David" wrote in message
...
Nigel,
If it's not too much trouble, currently, the spreadsheets that come in do
NOT have a location number, although the summary sheet does. I am
developing
an update to the spreadsheet that will have the location number in the
future. They do contain the date.
However, until then, could we put a user interface in that would ask the
operator for the location number if the field that will hold the location
number contains no data?

Thanks much again!!

David

"Nigel" wrote:

Glad you like it. You have to run it from the open source file - which
must
be active. I did it this way as when you click on the email attachment
this
becomes the open and active file. Running the macro should be OK -
(have
the summnary.xls open already). I could provide a trap to prevent it
running from elsewhere if you like?

You could do a lot more to prevent errors, validate dates etc. It
strucmk
me that the date provided in each office submission might not comply
with
the format rules - so an error trap here migth be good thing?

Also you need to add new offices and dates manually - this could be
automated.


--
Cheers
Nigel



"David" wrote in message
...
Never mind...you're a GENIUS. I ran the code from the open source file
and
it
worked perfect!
Thanks again!!!!!

"Nigel" wrote:

Hi David, here is one approach, place the following in a summary.xls
code
module. To use it, Open the summary workbook then open your data
source
(emailed attachement) with this active, choose run-macros
summary.xls!transfer and the value gets transferred into the
summary
book
in the matching location. If the office number and/or date is not
set
up in
the summary sheet then you get an error message. Alternatively you
might
want to use this to create a new office or date in the summary book.

Sub Transfer()
Dim wbSum As Workbook, wbData As Workbook
Set wbSum = Workbooks("Summary.xls")
Set wbData = ActiveWorkbook

' get source data from open sheet
Dim iOffice As Integer, iDate As Date, iValue
With wbData.Sheets("Sheet1")
iOffice = .Range("A1")
iDate = .Range("A2")
iValue = .Range("A3")
End With
' apply values to matched row and column
With wbSum.Sheets("Sheet1")
Dim lastrow As Long, lastcol As Long, xV As Long, xR As Long, xC
As
Long
lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
lastcol = .Cells(1, Columns.Count).End(xlToLeft).Column
'get matching row
For xV = 1 To lastrow
If iOffice = .Cells(xV, 1) Then xR = xV
Next xV
If xR = 0 Then MsgBox "Office: " & iOffice & " not found in
summary
table"

' get matching column
For xV = 1 To lastcol
If iDate = .Cells(1, xV) Then xC = xV
Next xV
If xC = 0 Then MsgBox "Date: " & iDate & " not found in summary
table"
If xR 0 And xC 0 Then .Cells(xR, xC) = iValue
End With

End Sub

--
Cheers
Nigel



"David" wrote in message
...
I receive about 50 spreadsheets each week by email. I open the
attachment,
verify the data and want to run a macro that will copy just one
cell
of
data
from the worksheet and put the value ($) into a seperate (always
the
same
name) workbook that has column headings (Row A) of the date of the
end
of
each week. Column A has the number of the office sending the data.
Each
worksheet I receive has both the week ending date (which
corresponds
to
the
date in Row A) and the office number (which corresponds to the
office
number
in Column A). The cell containing the data is always constant.
Example, the file I receive and open is from Office 10, (cell
A1=10),
and
dated 05/29/05 (cell A2=05/29/05). The total sales is $3,000 (cell
A3=3000).
I want to post the info in cell A3, to workbook named summary.xls
and
place
it in the correct cell for the matching week and office number. In
the
summary.xls workbook, let's say that week 05/29/05 is in cell F1,
and
Office
10 is in cell A11. The target cell would be the intersection of F1
and
A11
or
F11. How do I write a macro that reads the date, office variables
in
the
original workbook, then validates both variables in the new
workbook,
and
them determines the row and column and resolves to an individual
cell
to
write $3,000 to F11? This would be a great help!