Vlookup help please

[Chris]

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("A11").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:R50000C1)-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 ***

 

[OssieMac]

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("A11").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

 

[Chris]

thanks OssieMac - your code works very well and also thanks for cleaning
my old code too - really appreciated,

Cheers,

Chris.



*** Sent via Developersdex http://www.developersdex.com ***