Macro

E

evoxfan

2003 Excel

Big picture:
I want to create a budget (with a macro) from an Excel file I receive from
another department. I would like to save a blank budget file that can be
copied and used for different projects where I copy the worksheet I recieve
into a "blank budget file" and activate the macro to create the budget.

What I receive to convert (project file):
This project file has one worksheet that I am interested in.
On this worksheet, I only want information from Columns A through F.
There are headings for colums in row 7 with data starting with row 8.
Headings:
A7:SECTION
B7:DESCRIPTION
D7:RESPONSIBILITY
E7:COST
F7:SUB COST

Data below headings:

Section column(Column A):
Every row is either blank, contains a five digit number, contains a five
digit number with an apostrophe at the beginning, or contains "NO SPEC".

Description column(Column B-C):
This column of data is made up of columns B & C. Every row contains a blank
or text. Column B is the text description of the number section listed in
column A. Rows within Column C will have blanks or text as well. When text is
listed in column C, it is considered a sub category of the text listed in
column B.

Responsibility Column(Column D):
Contains blanks or text of the name of the assigned party.

Cost column(Column E):
Contains a number (dollar value), blanks, or text.

Subcost column(Column F):
Contains a number (dollar value), blanks, or text.

Information I do not want:
There is also general information describing the project in rows 1-5 that I
am not interested in.
There is also additional information starting in column G through N I don't
want.
There are also formulas in cells at the bottom of this data for summary(the
row this summary data starts in varies project to project but this
particular project starts in row 888 but another project could start in row
2000), but I am not interested in this summary data.

What I hope to achieve if possible:
A template file that creates budgets from any project file I receive.
I would like to be able to copy the worksheet from the project file into the
blank budget file where the macro will pull only the information I am
interested in from the project worksheet and puts it on another worksheet in
the format listed below.

Budget file columns:

Columns:
Account Code:
This colum only needs data from the section column. The section number will
be the account code, any blanks shoul be ignored, and the No Specs should be
included if assigned in value from the cost or subcost column.

Account description:
This should relate to the account code column with text describing it. This
data should come from the description column in column B of the project file.

Responsibilty:
This should correlate with the section number and description. It should
come from the responsibility column from the project file.

Labor:
This column should be a dollar value for all the labor or installation. Its
data comes from cost or subcost of the project sheet. Anywhere there is a
text "labor" or "installation" found in the project description column, it
should pull the value from cost or sub cost ccolumn and place in this budget
material column.

Material:
This column should be a dollar value for all the material. Its data comes
from cost or subcost of the project sheet. Anywhere there is a text
"material" or "materials" found in the project description column, it should
pull the value from cost or sub cost ccolumn and place in this budget
material column.

Subcontract:
This column should be a dollar value for all subcontracts. It should pull
any remaining values from the subcost project column. It value should have
its own row with corresponding data in the previous columns.

Other:
This column should be a dollar value of all remaining cost from the in the
project cost column. There should also be corresponding data in previous
columns.

Total:
This columns should just sum up the values of all previous columns listed.
This is the last column I need.

Additional data - I would like to sum up the total column at the bottom of
the data. Also, put a border around all of the data and bold border around
the column headings.

Although I can record macros and open VB, I cannot write code from scratch,
especially to accomplish this task. This is the best solution to what I am
trying to accomplish that I could come up with, any other suggestions are
welcome.

Please let me know if you need any additional information.

Thanks in advance for reading my dilemma and any help is greatly appreciated.
 
S

sbitaxi

Hello Evoxfan:

The summary row, is it always the last row of data?

Do you prefer the totals to be formulas or values? Values take up less
space in a workbook.

Do you want to store the source sheet and the generated budget report
in the same workbook (separate from the original, of course) or just
the generated budget?

Rows 1 to 6 are to be discarded?

How many worksheets do the source files contain and which sheet
contains the data?

Do you want the budget file to contain all generated budgets or just
the current one? (macro will either add a new workbook or worksheet)

You mentioned that blanks in the Section column should be ignored,
does that mean the other columns for the same record will also be
blank, or is the data in each column independent of the other? If we
ignore blanks (assume - remove) the number of rows in each column may
change and data displaced.

Material/Labour - is it possible that there is a value in both the
Cost and Sub Cost columns? Which takes priority? Should they be summed
in those instances?

Other - how are "remaining" costs determined? are these costs that
don't meet the Material/Labour criteria?



I've a macro that performs similar tasks, I'll tweak it this weekend,
based on your responses, to suit your requirements and you can test it
out on a sample book.


Steven
 
E

evoxfan

Hell Steven:

I just now have seen your response, and I have answered your questions for
clarification to the best of my ability. I hope this information helps and
please let me know if you need any additional clarifications.

Thanks for your efforts.

Hello Evoxfan:

The summary row, is it always the last row of data?

No, there is fw more cells with data after the summary row, but I can
manually delete them if it is necessary for the macro to work.
Do you prefer the totals to be formulas or values? Values take up less
space in a workbook.

When I paste the data worksheet, I plan on pasting it as values instead of
formulas. For the macro, I would prefer it to be formulas, but as long as it
works in can be values.
Do you want to store the source sheet and the generated budget report
in the same workbook (separate from the original, of course) or just
the generated budget?
I definitely plan on keeping the source sheet in the same workbook once it
is copied over.
Rows 1 to 6 are to be discarded?
Yes.

How many worksheets do the source files contain and which sheet
contains the data?

There is only one worksheet that contains the data, which I will copy into
the budget workbook. In this workbook, I plan on have the first work sheet
with instructions for the macro so others can use it, and a macro button to
press. The second worksheet is where I plan on the macro performing its work
and the third worksheet is where I plan on pasting the source data values and
formats only.
Do you want the budget file to contain all generated budgets or just
the current one? (macro will either add a new workbook or worksheet)

Just the current one.
You mentioned that blanks in the Section column should be ignored,
does that mean the other columns for the same record will also be
blank, or is the data in each column independent of the other? If we
ignore blanks (assume - remove) the number of rows in each column may
change and data displaced.

No. Just because the Section column is blank does not mean the others will
be blank. Each column has data independent of each other.
Material/Labour - is it possible that there is a value in both the
Cost and Sub Cost columns? Which takes priority? Should they be summed
in those instances?

They should be summed in these instances.
 
E

evoxfan

If it helps, below is a somewhat similar macro, but I am not sure how to
tweek it.


Sub findandcleanup()
'
'
' Uses find to locate "account code" then copies info wanted to different
sheet

Dim JUNK

' Copy Project info
Sheets("BID Budget").Select
Rows("5:6").Select
Selection.Copy
Sheets("Budget").Select
Rows("2:2").Select
ActiveSheet.Paste
Sheets("BID Budget").Select
Rows("8:9").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Budget").Select
Rows("4:4").Select
ActiveSheet.Paste

' Find first account code, save address and paste info to Budget sheet
Sheets("Budget").Select
Range("A8").Select
Sheets("BID Budget").Select
Range("A1").Select
Cells.find(What:="account code", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False).Activate
JUNK = ActiveCell.Address
ActiveCell.Offset(1, 0).Range("A1:E1").Select
Selection.Copy
Sheets("Budget").Select
ActiveSheet.Paste
Sheets("BID Budget").Select
ActiveCell.Offset(3, 2).Range("A1:K1").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Budget").Select
ActiveCell.Offset(0, 5).Range("A1").Select
ActiveSheet.Paste
ActiveCell.Offset(1, -5).Range("A1").Select
Sheets("BID Budget").Select
ActiveCell.Offset(0, -2).Range("A1").Select
Cells.find(What:="account code", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False).Activate

' Loops to find remaining cost codes
Do Until ActiveCell.Address = JUNK
ActiveCell.Offset(1, 0).Range("A1:E1").Select
Selection.Copy
Sheets("Budget").Select
ActiveSheet.Paste
Sheets("BID Budget").Select
ActiveCell.Offset(3, 2).Range("A1:K1").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Budget").Select
ActiveCell.Offset(0, 5).Range("A1").Select
ActiveSheet.Paste
ActiveCell.Offset(1, -5).Range("A1").Select
Sheets("BID Budget").Select
ActiveCell.Offset(0, -2).Range("A1").Select
Cells.find(What:="account code", After:=ActiveCell,
LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False).Activate
Loop

' Removes supply column
Sheets("Budget").Select
Columns("O:O").Select
Application.CutCopyMode = False
Selection.Insert Shift:=xlToRight
Range("N7").Select
Selection.Copy
Range("O7").Select
ActiveSheet.Paste
Range("O8").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=RC[-3]+RC[-1]"
Range("O8").Select
Selection.AutoFill Destination:=Range("O8:O58")
Range("O8:O58").Select
ActiveWindow.SmallScroll Down:=3
Columns("O:O").Select
Range("O4").Activate
Selection.Copy
Columns("N:N").Select
Range("N4").Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Columns("O:O").Select
Range("O4").Activate
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Columns("L:L").Select
Range("L4").Activate
Selection.Delete Shift:=xlToLeft

' Removes tax colummn
Columns("O:p").Select
Range("O4").Activate
Selection.Insert Shift:=xlToRight
Range("K7").Select
Selection.Copy
Range("O7").Select
ActiveSheet.Paste
Range("M7").Select
Application.CutCopyMode = False
Selection.Copy
Range("P7").Select
ActiveSheet.Paste
Range("O8").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=IF(RC[-4]=0,RC[-4],RC[-4]+RC[-1])"
Range("O8").Select
Selection.AutoFill Destination:=Range("O8:O58")
Range("O8:O58").Select
ActiveWindow.SmallScroll Down:=0
Range("P8").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-5]=0,RC[-3]+RC[-2],RC[-3])"
Range("P8").Select
Selection.AutoFill Destination:=Range("P8:p58")
Range("P8:p58").Select
Columns("O:O").Select
Range("O6").Activate
Selection.Copy
Columns("K:K").Select
Range("K6").Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Columns("P:p").Select
Range("P6").Activate
Application.CutCopyMode = False
Selection.Copy
Columns("M:M").Select
Range("M6").Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Columns("N:p").Select
Range("N6").Activate
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft

' Removes rental equipment column
Sheets("Budget").Select
ActiveWindow.SmallScroll Down:=-42
Columns("K:K").Select
Selection.Insert Shift:=xlToRight
Range("H7").Select
Selection.Copy
Range("K7").Select
ActiveSheet.Paste
Range("K8").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=RC[-3]+RC[-1]"
Range("K8").Select
Selection.AutoFill Destination:=Range("K8:K58")
Range("K8:K58").Select
Columns("K:K").Select
Selection.Copy
Columns("H:H").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Columns("J:K").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Range("A1").Select

' Delete extra column
Columns("C:C").Select
Selection.Delete Shift:=xlToLeft

' Add totals on the right hand side
Sheets("Budget").Select
Range("L8").Select
ActiveCell.FormulaR1C1 = "=SUM(RC[-7]:RC[-1])"
Range("L9").Select
ActiveWindow.SmallScroll Down:=-1
Range("L8").Select
Selection.AutoFill Destination:=Range("L8:L58")
Range("L8:L58").Select

' Format cells to white
Sheets("Budget").Select
Cells.Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Selection.Interior.ColorIndex = xlNone

' Add Idle info
Sheets("Instructions").Select
Rows("31:33").Select
Selection.Copy
Sheets("Budget").Select
ActiveWindow.SmallScroll Down:=-12
Rows("8:8").Select
Range("B8").Activate
Selection.Insert Shift:=xlDown

' Sort by account code
Rows("8:100").Select
Selection.Sort Key1:=Range("A8"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal

' Format Account Code
Sheets("Budget").Select
Range("A8:A100").Select
Selection.NumberFormat = "00000"
Range("A8:A100").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With

' Format Bid Quantity column
Range("C8:C100").Select
Selection.NumberFormat = "0"
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With

' Format numbers as accounting style
Range("E8:L100").Select
Selection.Style = "Currency"

' Copy and Paste Header
Sheets("Instructions").Select
Rows("24:24").Select
Selection.Copy
Sheets("Budget").Select
Rows("7:7").Select
ActiveSheet.Paste

' Hours lookups
Sheets("L&E emp by acct by CI").Select
Columns("A:J").Select
ActiveWorkbook.Names.Add Name:="hours", RefersToR1C1:= _
"='L&E emp by acct by CI'!C1:C10"
Sheets("Budget").Select
Range("M8").Select
ActiveCell.FormulaR1C1 = _

"=IF(ISERROR(VLOOKUP(RC[-12],hours,7,FALSE)),0,VLOOKUP(RC[-12],hours,7,FALSE))"
Range("M8").Select
Selection.AutoFill Destination:=Range("M8:M58"), Type:=xlFillDefault
Range("M8:M100").Select
ActiveWindow.SmallScroll Down:=-39
Range("N8").Select
ActiveCell.FormulaR1C1 = _

"=IF(ISERROR(VLOOKUP(RC[-13],hours,8,FALSE)),0,VLOOKUP(RC[-13],hours,8,FALSE))"
Range("N8").Select
Selection.AutoFill Destination:=Range("N8:N58")
Range("N8:N100").Select

Columns("M:N").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False

' Format Hours
Range("M8:N100").Select
Selection.NumberFormat = "0"
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With

' Delete rows with none and any others below that
Sheets("Budget").Select
Cells.find(What:="none", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:= _
False, SearchFormat:=False).Activate
ActiveCell.Rows("1:100").EntireRow.Select
Selection.Delete Shift:=xlUp

' Change format to bold
ActiveCell.Offset(1, 0).Rows("1:4").EntireRow.Select
Selection.Font.Bold = True

' Copy header info
Sheets("Instructions").Select
Range("A26:A29").Select
Selection.Copy
Sheets("Budget").Select
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveSheet.Paste
ActiveCell.Offset(0, 3).Range("A1").Select
Application.CutCopyMode = False

' Add totals and profit
ActiveCell.FormulaR1C1 = "=SUM(R8C:R[-1]C)"
ActiveCell.Select
Selection.AutoFill Destination:=ActiveCell.Range("A1:J1"), Type:= _
xlFillDefault
ActiveCell.Range("A1:J1").Select
ActiveCell.Range("A1:H1").Select
Selection.Style = "Currency"
ActiveCell.Offset(2, 7).Range("A1").Select
ActiveCell.FormulaR1C1 = "=R[-1]C-R[-2]C"
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveWindow.SmallScroll Down:=-1
ActiveCell.Offset(-3, 0).Range("A1:A3").Select
Selection.Style = "Currency"

' Input income value
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveCell = Application.InputBox( _
prompt:="Enter the Income # for this project", _
Title:="INCOME", Default:=0, Left:=20, Top:=20, Type:=1)

' Insert profit formula
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveWindow.SmallScroll Down:=-1
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveCell.FormulaR1C1 = "=R[-1]C/R[-2]C"
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveWindow.SmallScroll Down:=-1
ActiveCell.Offset(-1, 0).Range("A1").Select
Selection.NumberFormat = "0.00%"

' Format Columns
Range("M8:N100").Select
Selection.NumberFormat = "#,##0_);(#,##0)"
Columns("D:N").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
End With

' Resize columns
Sheets("Budget").Select
Columns("A:N").Select
Columns("A:N").EntireColumn.AutoFit

' Copy and Paste Note
Sheets("Instructions").Select
Range("C22:N22").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Budget").Select
Range("C5").Select
ActiveSheet.Paste

' Select first cell on sheet
Sheets("Instructions").Select
Range("A1").Select
Sheets("Budget").Select
Range("A1").Select


End Sub
Sub find()
'
' Macro by Judsen Jones
'
'
' Uses find to locate "account code" then copies info wanted to different
sheet

Dim JUNK

' Copy Project info
Sheets("BID Budget").Select
Rows("5:6").Select
Selection.Copy
Sheets("Budget").Select
Rows("2:2").Select
ActiveSheet.Paste
Sheets("BID Budget").Select
Rows("8:9").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Budget").Select
Rows("4:4").Select
ActiveSheet.Paste

' Find first account code, save address and paste info to Budget sheet
Sheets("Budget").Select
Range("A8").Select
Sheets("BID Budget").Select
Range("A1").Select
Cells.find(What:="account code", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False).Activate
JUNK = ActiveCell.Address
ActiveCell.Offset(1, 0).Range("A1:E1").Select
Selection.Copy
Sheets("Budget").Select
ActiveSheet.Paste
Sheets("BID Budget").Select
ActiveCell.Offset(3, 2).Range("A1:K1").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Budget").Select
ActiveCell.Offset(0, 5).Range("A1").Select
ActiveSheet.Paste
ActiveCell.Offset(1, -5).Range("A1").Select
Sheets("BID Budget").Select
ActiveCell.Offset(0, -2).Range("A1").Select
Cells.find(What:="account code", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False).Activate

' Loops to find remaining cost codes
Do Until ActiveCell.Address = JUNK
ActiveCell.Offset(1, 0).Range("A1:E1").Select
Selection.Copy
Sheets("Budget").Select
ActiveSheet.Paste
Sheets("BID Budget").Select
ActiveCell.Offset(3, 2).Range("A1:K1").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Budget").Select
ActiveCell.Offset(0, 5).Range("A1").Select
ActiveSheet.Paste
ActiveCell.Offset(1, -5).Range("A1").Select
Sheets("BID Budget").Select
ActiveCell.Offset(0, -2).Range("A1").Select
Cells.find(What:="account code", After:=ActiveCell,
LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False).Activate
Loop

End Sub




Sub CombineDuplicates()
'Combine Duplicates in Column called out "A"
Dim LastRow As Long
Dim i As Long
Application.ScreenUpdating = False
LastRow = Range("A" & Rows.Count).End(xlUp).Row
For i = LastRow To 1 Step -1
If WorksheetFunction.CountIf(Range("A:A"), Range("A" & i)) > 1 Then
Range("A" & i).Select
ActiveCell.Offset(1, 0).EntireRow.Insert
ActiveCell.Offset(1, 4).Select
ActiveCell.FormulaR1C1 = "=R[-2]C+R[-1]C"
Selection.AutoFill Destination:=ActiveCell.Range("A1:G1"), Type:= _
xlFillDefault
ActiveCell.Range("A1:G1").Select
Selection.Copy
ActiveCell.Offset(-2, 0).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
ActiveCell.Offset(1, 0).Rows("1:2").EntireRow.Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp
End If
Next 'i
Application.ScreenUpdating = True
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