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!
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!
[vba]
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
[/vba]
____________________________________________
Nihil simul inventum est et perfectum
Abusus non tollit usum
Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
James Thurber
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!
[VBA]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
[/VBA]
MVP (Excel 2008-2010)
Post a workbook with sample data and layout if you want a quicker solution.
To help indent your macros try Smart Indent
Please remember to mark threads 'Solved'
It was perfect you are a great genius! Thank you very much thank you
XLD did the hard work!
MVP (Excel 2008-2010)
Post a workbook with sample data and layout if you want a quicker solution.
To help indent your macros try Smart Indent
Please remember to mark threads 'Solved'
So thank you very much to both geniuses
Posting Permissions
Reply With Quote
