Data from 2 sheets to create a new sheet with user input?

C

C

I have 2 spreadsheets that contain information for monthly forecasting. We
update the forecast and current orders weekly. Active orders contains
monthly quantity data as shown below:

Active Orders.xls
A B C D E
Item Description Item # QTY-Sep 09 Qty-Oct 09 Qty-Nov 09
Widget Spring SP-1015 15 50 100

The second spreadsheet (product cost.xls) contains cost data as shown below:

Product Cost.xls
A B C
Item Description Item # Cost
Widget Spring SP-1015 $10.00

Is there a way in VBA or user forms or both to create a new spreadsheet that
would take the column headings and populate the item description and item #
fields then take the qty from Active Orders.xls and go find the item # in
product cost and multiply the qty by cost and populat the sheet based on a
user defined percentage markup. Such as below with a user defined percentage
markup of 10%:

New costed work sheet
A B C D E
Item Description Item # QTY-Sep 09 Qty-Oct 09 Qty-Nov 09
Widget Spring SP-1015 165 550 1100

I am not a programmer but have read some about macros and forms. Any help,
advice or guidance is greatly appreciated as it would reduce errors and
effort.

Thanks in advance,
C
 
J

Joel

Place this code in a newworkbook. The code will prompt to open two
workbnooks and put the results in the 3rd workbook where the macro is locate.
the code assumes the Cost and Order workbooks have the data in the 1st tab
of each workbook. The title of the dialog box which prompts for the filename
will specify which file you need to select.

Sub CreateMonthlyforecast()

ActiveOrderFilename = Application.GetOpenFilename( _
filefilter:="Excel Files (*.xls), *.xls", _
Title:="Get Active Orders Workbook")
If ActiveOrderFilename = False Then
MsgBox ("Cannot Open file - Exiting Macro")
Exit Sub
End If

ProductCostFilename = Application.GetOpenFilename( _
filefilter:="Excel Files (*.xls), *.xls", _
Title:="Get Product Cost Workbook")
If ProductCostFilename = False Then
MsgBox ("Cannot Open file - Exiting Macro")
Exit Sub
End If

Markup = InputBox(prompt:="Enter Markup Percentage (1.10) : ", _
Title:="Get Markup Percentage")
If IsNumeric(Markup) Then
Markup = Val(Markup)
Else
MsgBox ("Invalid Markup - exiting Macro")
Exit Sub
End If

Set OrderBk = Workbooks.Open(Filename:=ActiveOrderFilename)
Set OrderSht = OrderBk.Sheets(1)

Set CostBk = Workbooks.Open(Filename:=ProductCostFilename)
Set CostSht = CostBk.Sheets(1)

'add new sheet to current workbook
With ThisWorkbook
.Sheets.Add after:=.Sheets(.Sheets.Count)
Set NewSht = .ActiveSheet
End With

With OrderSht
'copy header row
.Rows(1).Copy Destination:=NewSht.Rows(1)
RowCount = 2
Do While .Range("B" & RowCount) <> ""
ItemNumber = .Range("B" & RowCount)
'copy description and item number
.Range("A" & RowCount & ":B" & RowCount).Copy _
Destination:=NewSht.Range("A" & RowCount)
With CostSht
Set c = .Columns("B").Find(what:=ItemNumber, _
LookIn:=xlValues, lookat:=xlWhole)
End With

If c Is Nothing Then
MsgBox ("Cannot find item : " & ItemNumber)
'highlight column and and b
NewSht.Range("A" & RowCount & ":B" & RowCount) _
.Interior.ColorIndex = 3
Else
cost = c.Offset(0, 1)
LastCol = _
.Cells(RowCount, Columns.Count).End(xlToLeft).Column
For ColCount = 3 To LastCol
Qty = .Cells(RowCount, ColCount)
NewSht.Cells(RowCount, ColCount) = _
Qty * cost * Markup
Next ColCount
End If

RowCount = RowCount + 1
Loop

End With

NewSht.Columns.AutoFit

OrderBk.Close savechanges:=False
CostBk.Close savechanges:=False
End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top