Script problem - Help please
 

Hi, Tom Ogilvy kindly gave me the code below, which works fantastic. All
i need is that if it does not find a value it must leave the cell that
it is copying to blank, at the moment it is putting in a zero. So in
other words i only need it to copy the cells with a value in.
Could somebody please give some advice how i can change the code?


Sub LookupsAA()

Dim myLookUpRng As Range
Dim i As Long
Dim NumRows As Long
Dim LastRow As Long
Range("D4").Select
With Workbooks(SuppFileNameC).Worksheets(SheetName)
Set myLookUpRng = .Range("D:N")
End With
LastRow = Cells(Rows.Count, "D").End(xlUp).Row
NumRows = LastRow - 3
With Cells(4,L).Resize(NumRows)
.Formula = "=Vlookup(D4," & _
myLookupRng.Address(1,1,xlA1,True) & ",9,0)"
.Value = .Value
End With
With Cells(4,M).Resize(NumRows)
.Formula = "=Vlookup(D4," & _
myLookupRng.Address(1,1,xlA1,True) & ",10,0)"
.Value = .Value
End with
With Cells(4,"L").Resize(NumRows)
.Font.ColorIndex = 3
.Font.bold = True
End With
Range("A4").Select
CloseForm2
End Sub


Les Stout

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

Script problem - Help please
 

I've not done this with VBA, but I've done it with the regular EXCEL
formulas. Maybe you can figure out how to get it to work in VBA.

This formula will fill in a "" if there is nothing found.

=IF(ISNA(VLOOKUP(D4,LookupRange,2,FALSE)),"",VLOOK UP(D4,LookupRange,2,FALSE))


"Les Stout" wrote in message
...
Hi, Tom Ogilvy kindly gave me the code below, which works fantastic. All
i need is that if it does not find a value it must leave the cell that
it is copying to blank, at the moment it is putting in a zero. So in
other words i only need it to copy the cells with a value in.
Could somebody please give some advice how i can change the code?


Sub LookupsAA()

Dim myLookUpRng As Range
Dim i As Long
Dim NumRows As Long
Dim LastRow As Long
Range("D4").Select
With Workbooks(SuppFileNameC).Worksheets(SheetName)
Set myLookUpRng = .Range("D:N")
End With
LastRow = Cells(Rows.Count, "D").End(xlUp).Row
NumRows = LastRow - 3
With Cells(4,L).Resize(NumRows)
.Formula = "=Vlookup(D4," & _
myLookupRng.Address(1,1,xlA1,True) & ",9,0)"
.Value = .Value
End With
With Cells(4,M).Resize(NumRows)
.Formula = "=Vlookup(D4," & _
myLookupRng.Address(1,1,xlA1,True) & ",10,0)"
.Value = .Value
End with
With Cells(4,"L").Resize(NumRows)
.Font.ColorIndex = 3
.Font.bold = True
End With
Range("A4").Select
CloseForm2
End Sub


Les Stout

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

Script problem - Help please
 

It may be as simple as Tools/Options - View tab, and uncheck 'Zeros'.

Mike F
"Les Stout" wrote in message
...
Hi, Tom Ogilvy kindly gave me the code below, which works fantastic. All
i need is that if it does not find a value it must leave the cell that
it is copying to blank, at the moment it is putting in a zero. So in
other words i only need it to copy the cells with a value in.
Could somebody please give some advice how i can change the code?


Sub LookupsAA()

Dim myLookUpRng As Range
Dim i As Long
Dim NumRows As Long
Dim LastRow As Long
Range("D4").Select
With Workbooks(SuppFileNameC).Worksheets(SheetName)
Set myLookUpRng = .Range("D:N")
End With
LastRow = Cells(Rows.Count, "D").End(xlUp).Row
NumRows = LastRow - 3
With Cells(4,L).Resize(NumRows)
.Formula = "=Vlookup(D4," & _
myLookupRng.Address(1,1,xlA1,True) & ",9,0)"
.Value = .Value
End With
With Cells(4,M).Resize(NumRows)
.Formula = "=Vlookup(D4," & _
myLookupRng.Address(1,1,xlA1,True) & ",10,0)"
.Value = .Value
End with
With Cells(4,"L").Resize(NumRows)
.Font.ColorIndex = 3
.Font.bold = True
End With
Range("A4").Select
CloseForm2
End Sub


Les Stout

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

Script problem - Help please
 

replace
.Value = .Value
with
If .Value = 0 then .value = ""
.Value = .Value


"Les Stout" wrote:

Hi, Tom Ogilvy kindly gave me the code below, which works fantastic. All
i need is that if it does not find a value it must leave the cell that
it is copying to blank, at the moment it is putting in a zero. So in
other words i only need it to copy the cells with a value in.
Could somebody please give some advice how i can change the code?


Sub LookupsAA()

Dim myLookUpRng As Range
Dim i As Long
Dim NumRows As Long
Dim LastRow As Long
Range("D4").Select
With Workbooks(SuppFileNameC).Worksheets(SheetName)
Set myLookUpRng = .Range("D:N")
End With
LastRow = Cells(Rows.Count, "D").End(xlUp).Row
NumRows = LastRow - 3
With Cells(4,L).Resize(NumRows)
.Formula = "=Vlookup(D4," & _
myLookupRng.Address(1,1,xlA1,True) & ",9,0)"
.Value = .Value
End With
With Cells(4,M).Resize(NumRows)
.Formula = "=Vlookup(D4," & _
myLookupRng.Address(1,1,xlA1,True) & ",10,0)"
.Value = .Value
End with
With Cells(4,"L").Resize(NumRows)
.Font.ColorIndex = 3
.Font.bold = True
End With
Range("A4").Select
CloseForm2
End Sub


Les Stout

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

Script problem - Help please
 

Just add this line after all the main work has been done

Cells(4, l).Resize(NumRows, 2).Replace "0", ""


--

HTH

RP
(remove nothere from the email address if mailing direct)


"Les Stout" wrote in message
...
Hi, Tom Ogilvy kindly gave me the code below, which works fantastic. All
i need is that if it does not find a value it must leave the cell that
it is copying to blank, at the moment it is putting in a zero. So in
other words i only need it to copy the cells with a value in.
Could somebody please give some advice how i can change the code?


Sub LookupsAA()

Dim myLookUpRng As Range
Dim i As Long
Dim NumRows As Long
Dim LastRow As Long
Range("D4").Select
With Workbooks(SuppFileNameC).Worksheets(SheetName)
Set myLookUpRng = .Range("D:N")
End With
LastRow = Cells(Rows.Count, "D").End(xlUp).Row
NumRows = LastRow - 3
With Cells(4,L).Resize(NumRows)
.Formula = "=Vlookup(D4," & _
myLookupRng.Address(1,1,xlA1,True) & ",9,0)"
.Value = .Value
End With
With Cells(4,M).Resize(NumRows)
.Formula = "=Vlookup(D4," & _
myLookupRng.Address(1,1,xlA1,True) & ",10,0)"
.Value = .Value
End with
With Cells(4,"L").Resize(NumRows)
.Font.ColorIndex = 3
.Font.bold = True
End With
Range("A4").Select
CloseForm2
End Sub


Les Stout

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

Script problem - Help please
 

Thanks all for the input. Bob, rather like your suggestion and shall try
it out at work tomorrow.

best regards,

Les Stout

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