Copy to cells based on Row/Column labels in another workbook
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!
|