Copy workbook with increased values.

[bmpc]

One of my suppliers sends me a nice workbook with my wholesale prices. Is there an easy way to copy the entire workbook (8 sheets) to a new workbook while increasing the values in a given column (which varies by page) by a given percentage?

[Qroozn]

it all depends on wether his wholesale book is consistent.
you can always have a cell at the top of each page which says the markup percentage, and then do a edit/pastespecial/multiply by this cell value.

[Jay Petrulis]

Hi,

The following routine will prompt you to load the file from the supplier.

It will then search column A in each worksheet and increment cells with numerical values by 20%. It will leave text and formula cells unchanged.

***PLEASE NOTE THAT THIS WILL CHANGE THE ORIGINAL FILE, SO PLEASE SAVE THE FILE TO A NEW NAME AFTER RUNNING THE PROCEDURE***

I arbitrarily picked 20% as the markup, but you can change that easily. Modify the column to change as well

'---begin VBA---
Sub test()
Dim WS As Worksheet, Rng As Range
Dim UsedCell As Range, Markup As Double
Dim SupplierFile As String, SupplyFile As String

Markup = 0.2
SupplierFile = Application.GetOpenFilename(Title:="Load File")
If SupplierFile <> "False" Then
Workbooks.Open Filename:=SupplierFile
SupplierFile = ActiveWorkbook.Name
For Each WS In Workbooks(SupplierFile).Worksheets
Set Rng = Intersect(WS.UsedRange, WS.Range("A:A"))
For Each UsedCell In Rng
If Not UsedCell.HasFormula Then
If WorksheetFunction.IsNumber(UsedCell) Then UsedCell = UsedCell * (1 + Markup)
End If
Next UsedCell
Next WS
End If
End Sub
'---end VBA---

HTH,
Jay

EDIT: This can be stored anywhere, including your personal.xls file if you use that. I called the file which houses this Controller.xls.

The prompt allows you to search any directory for the supplier file, so the supplier can call the workbook whatever he wants and you can store it wherever you want. You'll have to detach it from an e-mail attachment, though.

[ This Message was edited by: Jay Petrulis on 2002-04-23 20:25 ]