lakshmipathi123
Board Regular
- Joined
- Jul 10, 2012
- Messages
- 52
- Office Version
- 365
- Platform
- Windows
Hi Experts,
Pls find below codings for Fixed asset register. it is working fine but i feel slow. Kindly advice on following
1. Speed up my macro
2. Is there any suggestions or modifications to make short codings instead of 2 pages of macro.
Thanks in Advance
Lakshmipathi
Pls find below codings for Fixed asset register. it is working fine but i feel slow. Kindly advice on following
1. Speed up my macro
2. Is there any suggestions or modifications to make short codings instead of 2 pages of macro.
Code:
Sub UFAR()
'
' UFAR Macro
'
Dim dLastRow As Double
dLastRow = ActiveCell.SpecialCells(xlCellTypeLastCell).Row
Rows("1:11").Select
Selection.EntireRow.Delete
dLastRow = dLastRow - 11
Range("A1:A5").Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 1), Array(185, 1), Array(551, 1)), TrailingMinusNumbers _
:=True
Range("A1:D4").Select
Selection.Copy
Sheets("Sheet2").Select
Range("A2").Select
ActiveSheet.Paste
Sheets("Main").Select
Rows("1:5").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp
Range("A1").Select
Range(Selection, Cells(dLastRow, 1)).Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 1), Array(17, 1), Array(18, 1), Array(31, 1), Array(32, 1), _
Array(62, 1), Array(63, 1), Array(67, 1), Array(68, 1), Array(84, 1), Array(85, 1), Array( _
99, 1), Array(100, 1), Array(114, 1), Array(115, 1), Array(131, 1), Array(132, 1), Array( _
146, 1), Array(147, 1), Array(156, 1), Array(157, 1), Array(160, 1), Array(161, 1), Array( _
165, 1), Array(166, 1), Array(174, 1), Array(175, 1), Array(183, 1), Array(184, 1), Array( _
194, 1), Array(195, 1), Array(201, 1), Array(202, 1), Array(232, 1), Array(233, 1), Array( _
263, 1), Array(264, 1), Array(269, 1), Array(270, 1), Array(274, 1), Array(275, 1), Array( _
280, 1), Array(281, 1), Array(285, 1), Array(286, 1), Array(292, 1), Array(293, 1), Array( _
297, 1), Array(298, 1), Array(318, 1), Array(319, 1), Array(349, 1), Array(350, 1), Array( _
352, 1), Array(353, 1), Array(383, 1), Array(384, 1), Array(404, 1), Array(405, 1), Array( _
417, 1), Array(418, 1), Array(422, 1), Array(423, 1), Array(453, 1), Array(454, 1), Array( _
462, 1), Array(463, 1), Array(469, 1), Array(470, 1), Array(480, 1), Array(481, 1), Array( _
491, 1), Array(492, 1), Array(504, 1), Array(505, 1), Array(515, 1), Array(516, 1), Array( _
526, 1), Array(527, 1), Array(543, 1), Array(544, 1), Array(554, 1), Array(555, 1), Array( _
585, 1), Array(586, 1), Array(616, 1), Array(617, 1), Array(647, 1), Array(648, 1), Array( _
678, 1), Array(679, 1), Array(714, 1), Array(715, 1)), TrailingMinusNumbers:=True
Range("A1").Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Range("A1").Select
Do Until ActiveCell = ""
If ActiveCell = "|" Then
ActiveCell.EntireColumn.Delete
ActiveCell.Offset(0, -1).Select
End If
ActiveCell.Offset(0, 1).Select
Loop
With Selection.Font
.name = "Arial"
.Size = 9
End With
Rows("2:2").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Font.Bold = True
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
End With
Columns("K:K").Select
Selection.Insert Shift:=xlToRight
Range("K1").Select
ActiveCell.FormulaR1C1 = "End Date"
With Range("K2:K" & Range("J" & Rows.count).End(xlUp).Row)
.FormulaR1C1 = "=IFERROR(EOMONTH(RC[-1],RC[2]-1),"""")"
.Value = .Value
End With
Columns("Y:Y").Select
Selection.Insert Shift:=xlToRight
Range("Y1").Select
ActiveCell.FormulaR1C1 = "BU"
With Range("Y2:Y" & Range("X" & Rows.count).End(xlUp).Row)
.FormulaR1C1 = "=IFERROR(VLOOKUP(RC[-1],BU!C[-22]:C[-16],7,0),"""")"
.Value = .Value
End With
Columns("AG:AG").Select
Selection.Insert Shift:=xlToRight
Range("AG1").Select
ActiveCell.FormulaR1C1 = "Project Name"
With Range("AG2:AG" & Range("AF" & Rows.count).End(xlUp).Row)
.FormulaR1C1 = "=IFERROR(VLOOKUP(RC[-1],Projects!C[-32]:C[-31],2,0),"""")"
.Value = .Value
End With
Columns("A:A").Select
Range(Selection, Selection.End(xlToRight)).Select
Application.CutCopyMode = False
With Selection
.HorizontalAlignment = xlGeneral
.HorizontalAlignment = xlLeft
End With
Range("E:I,J:M,Q:Q,X:Y,Z:Z,AK:AK").Select
With Selection
.HorizontalAlignment = xlCenter
End With
Columns("AH:AH").Select
With Selection
.HorizontalAlignment = xlRight
End With
Range("B:B", "T:T").Select
Application.CutCopyMode = False
Selection.NumberFormat = "General"
Columns("E:I").Select
Selection.Style = "Comma"
Columns("J:K").Select
Selection.NumberFormat = "[$-409]dd-mmm-yy;@"
Columns("AK:AK").Select
Selection.NumberFormat = "[$-409]mmm-yy;@"
Cells.Select
Columns.AutoFit
Sheets("Main").Select
Rows("1:5").Select
Selection.Insert Shift:=xlDown
Sheets("Sheet2").Select
Range("A2:C5").Select
Selection.Copy
Sheets("Main").Select
Range("A1").Select
ActiveSheet.Paste
Range("B1:B4").Select
Application.CutCopyMode = False
Selection.Cut
Range("I1").Select
ActiveSheet.Paste
Range("AK2").Select
Range("C1:C4").Select
Selection.Cut
Range("AK1").Select
ActiveSheet.Paste
Range("A1").Select
End Sub
Lakshmipathi
Last edited by a moderator: