Thread: Macro
View Single Post
  #4   Report Post  
Posted to microsoft.public.excel.programming
evoxfan evoxfan is offline
external usenet poster
  
Posts: 65
Default Macro
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



"evoxfan" wrote:

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.

" wrote:

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.

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

Any remaining cost that is not material or labor, will be classified as sub or other. Sub will take any remaining cost out the Subcost column and Other will take remaing cost from the Cost column.

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

Reply With QuoteReply With Quote