Hi Chris,
Ensure that you back up your workbook in case the code does not do exactly
what you want then try the following code.
Your code could be improved on but I have only made minimal changes to cover
your specific question and also give you a better method of finding the last
cell in columns.
Hope it helps and feel free to get back to me if it does not do what you want.
Sub New_Line()
Range("A2").Select
Application.ScreenUpdating = False
'I think that the last cell should be named here
'and not at the end of the sub.
With Sheets("Register")
'Following line of code is like selecting the last cell
'in the column and holding the Ctrl key and press Up arrow
'It then names the cell.
.Cells(.Rows.Count, "A").End(xlUp).Name = "LastCell"
'Following line finds last cell in column M and
'copies that cell formula to the row below.
.Cells(.Rows.Count, "M").End(xlUp).Copy _
Destination:=.Cells(.Rows.Count, "M") _
.End(xlUp).Offset(1, 0)
End With
Range("LastCell").Select
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveCell.Rows("1:1").EntireRow.Select
Selection.RowHeight = 25.5
ActiveCell.Range("A1:P1").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Font
.Name = "Arial"
.FontStyle = "Regular"
.Size = 8
End With
With Selection
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.ShrinkToFit = False
.MergeCells = False
End With
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
With Selection
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.ShrinkToFit = False
.MergeCells = False
End With
Sheets("Register").Select
Range("LastCell").Offset(1, 0).Select
End Sub
--
Regards,
OssieMac
"Chris" wrote:
Hello, could someone please help me with the following:
Column M of my worksheet (Named: Register) contains fund numbers. The
algorithm below is currently in cells: M3:M4.
The VLOOKUP looks up the table on the worksheet (Named: Fund) that is
also contained in the same workbook.
The named range "Fund" is as follows: =Fund!$A$2:$B$51
What I need is that when the below subroutine (New_Line) is run, then
the VLOOKUP algorithm is inserted in the next row in column M.
For example: The VLOOKUP algorithm is at the moment only in cells M3 and
M4. When the subroutine (New_Line) is next run, I need the VLOOKUP
algorithm to be inserted in cell M5. After that, when I run the
subroutine again, then cell M6 needs the VLOOKUP algorithm in it and so
on.
I tried placing the VLOOKUP algorithm in all the cells from M3:M50000,
however the spreadsheet size went from 70K to over 5Mb.
Any help would be greatly appreciated.
Thanks,
Chris.
=IF(ISNA(VLOOKUP(L3,Fund,2,0)),"",VLOOKUP(L3,Fund, 2,FALSE))
LastCell=offset(Register!$A$3,COUNTA(Register!$A$3 :$A$50000)-1,0)
Sub New_Line()
Range("A2").Select
Application.ScreenUpdating = False
Range("LastCell").Select
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveCell.Rows("1:1").EntireRow.Select
Selection.RowHeight = 25.5
ActiveCell.Range("A1:P1").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Font
.Name = "Arial"
.FontStyle = "Regular"
.Size = 8
End With
With Selection
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.ShrinkToFit = False
.MergeCells = False
End With
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
With Selection
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.ShrinkToFit = False
.MergeCells = False
End With
Range("LastCell").Select
ActiveWorkbook.Names.Add Name:="LastCell", RefersToR1C1:= _
"=OFFSET(Register!R3C1,COUNTA(Register!R3C1:R50000 C1)-1,0)"
ActiveCell.Activate
Sheets("Register").Select
Range("LastCell").Select
ActiveCell.Offset(1, 0).Range("A1").Select
End Sub
*** Sent via Developersdex http://www.developersdex.com ***