PDA

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: