View Full Version : Reduce code and return empty if empty
marreco
02-19-2012, 08:31 AM
hello
I'd like to shorten this code can anyone in judar?
When the cells are empty the row must be empty!
For better understanding see the attachment!
Bob Phillips
02-19-2012, 09:30 AM
Sub ReturFunction()
Application.ScreenUpdating = False
Call Lookups(Range("D20"), Range("E20:J20"))
Call Lookups(Range("D20"), Range("E21:J21"))
Call Lookups(Range("D20"), Range("E22:J22"))
Call Lookups(Range("D20"), Range("E23:J23"))
Call Lookups(Range("D20"), Range("E24:J24"))
Call Lookups(Range("D20"), Range("E25:J25"))
Call Lookups(Range("D20"), Range("E26:J26"))
Application.ScreenUpdating = True
End Sub
Private Sub Lookups(ByVal LookupValue As Variant, ByRef Target As Range)
With Target
.Cells(1, 1).Value = Application.VLookup(LookupValue, Range("RelVenda!$A$1:$R$5000"), 6, False) 'Item
.Cells(1, 2).Value = Application.VLookup(LookupValue, Range("RelVenda!$A$1:$R$5000"), 7, False) 'Código
.Cells(1, 3).Value = Application.VLookup(LookupValue, Range("RelVenda!$A$1:$R$5000"), 8, False) 'Descrição
.Cells(1, 4).Value = Application.VLookup(LookupValue, Range("RelVenda!$A$1:$R$5000"), 9, False) 'Quantidade
.Cells(1, 5).Value = Application.VLookup(LookupValue, Range("RelVenda!$A$1:$R$5000"), 10, False) 'Unidade
.Cells(1, 6).Value = Application.VLookup(LookupValue, Range("RelVenda!$A$1:$R$5000"), 11, False) 'Preço Unitário
End With
End Sub
marreco
02-19-2012, 09:43 AM
Thank you for responding, but when I got up D23 E23 J23 empty should return empty.
in other words, if the cells D20 or D21 to D26 corresponding rows are empty should return empty
Muto thank you!
mdmackillop
02-19-2012, 02:50 PM
Option Explicit
Sub ReturFunction()
Dim i As Long
Application.ScreenUpdating = False
For i = 0 To 6
If Range("D20").Offset(i) <> "" Then
Call Lookups(Range("D20").Offset(i), Range("E20:J20").Offset(i))
Else
Range("E20:J20").Offset(i).ClearContents
End If
Next
Application.ScreenUpdating = True
End Sub
Private Sub Lookups(ByVal LookupValue As Variant, ByRef Target As Range)
With Target
.Cells(1, 1).Value = Application.VLookup(LookupValue, Range("RelVenda!$A$1:$R$5000"), 6, False) 'Item
.Cells(1, 2).Value = Application.VLookup(LookupValue, Range("RelVenda!$A$1:$R$5000"), 7, False) 'Código
.Cells(1, 3).Value = Application.VLookup(LookupValue, Range("RelVenda!$A$1:$R$5000"), 8, False) 'Descrição
.Cells(1, 4).Value = Application.VLookup(LookupValue, Range("RelVenda!$A$1:$R$5000"), 9, False) 'Quantidade
.Cells(1, 5).Value = Application.VLookup(LookupValue, Range("RelVenda!$A$1:$R$5000"), 10, False) 'Unidade
.Cells(1, 6).Value = Application.VLookup(LookupValue, Range("RelVenda!$A$1:$R$5000"), 11, False) 'Preço Unitário
End With
End Sub
marreco
02-19-2012, 03:10 PM
It was perfect you are a great genius! Thank you very much thank you
mdmackillop
02-19-2012, 03:14 PM
XLD did the hard work!
marreco
02-19-2012, 03:27 PM
So thank you very much to both geniuses:bow:
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.