View Full Version : Help to reduce the VBA code length
alexnkc
11-28-2013, 11:32 PM
Hi,
Is there anyway to Lean up the code below?
Sub test()
With Range("K7")
.Offset(1, 0).Range("A1").FormulaR1C1 = _
"=IF(RC[-1]=""-"",""-""," & _
"IF(VLOOKUP(RC[-4],R8C2:R400C4,1,1)<>RC[-4],""Pending...""," & _
"IF(RC[-4]=R[-1]C[-4],R[-1]C,IF(RC[-1]=""Ok"",VLOOKUP(RC[-4],R8C2:R400C4,3,0)," & _
"IF(OR(RC[-1]=""IPG"",RC[-1]=""Bad""),VLOOKUP(RC[-4],R8C2:R400C4,3,0)+R[-1]C,"""")))))"
.Offset(1, 0).Range("A1").Select
'PasteSpecial (Formula) to all the below cells
Selection.Copy
Range(Selection, Selection.End(xlDown)).Select
Selection.PasteSpecial Paste:=xlPasteFormulas
'PasteSpecial (Value) to all the below cells
Selection.Copy
Range(Selection, Selection.End(xlDown)).Select
Selection.PasteSpecial Paste:=xlPasteValues
End With
End Sub
Sub test()
Range(Range("K8"),range(K8").end(xldown))= "=IF(RC[-1]=""-"",""-"",IF(VLOOKUP(RC[-4],R8C2:R400C4,1,1)<>RC[-4],""Pending...""," & _
"IF(RC[-4]=R[-1]C[-4],R[-1]C,IF(RC[-1]=""Ok"",VLOOKUP(RC[-4],R8C2:R400C4,3,0),IF(OR(RC[-1]=""IPG"",RC[-1]=""Bad""),VLOOKUP(RC[-4],R8C2:R400C4,3,0)+R[-1]C,"""")))))"
End Sub
Sub test()
Dim Cel As Range
Set Cel = Range("K7").Offset(1, 0 )
With Cel
.FormulaR1C1 = _
"=IF(RC[-1]=""-"",""-""," & _
"IF(VLOOKUP(RC[-4],R8C2:R400C4,1,1)<>RC[-4],""Pending...""," & _
"IF(RC[-4]=R[-1]C[-4],R[-1]C,IF(RC[-1]=""Ok"",VLOOKUP(RC[-4],R8C2:R400C4,3,0)," & _
"IF(OR(RC[-1]=""IPG"",RC[-1]=""Bad""),VLOOKUP(RC[-4],R8C2:R400C4,3,0)+R[-1]C,"""")))))"
'PasteSpecial (Formula) to all the below cells
.Copy
Range(Cel, .End(xlDown)).PasteSpecial Paste:=xlPasteFormulas
'PasteSpecial (Value) to all the below cells
Range(Cel, .End(xlDown)).Copy
.PasteSpecial Paste:=xlPasteValues
End With
End Sub
Paul_Hossler
11-29-2013, 09:20 AM
Q: since you end up making the results into values anyway, why not just have the VBA loop and call VLookup directly, and just retain the result(s) where you want?
Paul
alexnkc
12-01-2013, 08:37 AM
Hi guy,
I think i found the way to make the code shorter and having same function to what i looking for.
Sub test2()
With Range(Range("K8"),range(K8").end(xldown))
.FormulaR1C1 = _
"=IF(RC[-1]=""-"",""-""," & _
"IF(VLOOKUP(RC[-4],R8C2:R400C4,1,1)<>RC[-4],""Pending...""," & _
"IF(RC[-4]=R[-1]C[-4],R[-1]C,IF(RC[-1]=""Ok"",VLOOKUP(RC[-4],R8C2:R400C4,3,0)," & _
"IF(OR(RC[-1]=""IPG"",RC[-1]=""Bad""),VLOOKUP(RC[-4],R8C2:R400C4,3,0)+R[-1]C,"""")))))"
.Value = .Value
End With
End Sub
alexnkc
12-01-2013, 08:39 AM
Hi Paul_Hossler,
I am very new in VBA and therefore don't understand what you try to share. Could you show some example so that i will be able to catch more.
Thanks
Paul_Hossler
12-01-2013, 12:11 PM
This is my opinion and personal style. Nothing wrong with the way you did it, but this is just another way to keep in mind
I've never been good about understanding or making long and complicated worksheet formulas, so I did not try to convert yours.
If you want to turn it into words I'll look at it
Just a simple demo of a couple of techniques
Option Explicit
Sub test2a()
Dim rCell As Range
Dim sLookup As String, sReturn As String
For Each rCell In Range(Range("K8"), Range("K8").End(xlDown)).Cells
With rCell
'offset - same row (0) one col to left (-1)
sLookup = .Offset(0, -1).Value & "-" & .Value
'set test value
sReturn = vbNullString
'if not found, continue, but we have a value to test for
On Error Resume Next
sReturn = Application.WorksheetFunction.VLookup(sLookup, Range("B2:D4000"), 3, 0)
On Error GoTo 0
'we found a lookup so use it
If Len(sReturn) > 0 Then
.Value = sReturn
'use something else
Else
.Value = "Bad"
End If
End With
Next
End Sub
Paul
As the code drops down thu the IF's and ELSEIF's it will exit the IF as soon as a match is made.
Sub test2()
Dim Cel As Range
Dim VRng As Range
Set VRng = Range("B8:D400)
For Each Cel In Range(Range("K8"),Range(K8").End(xlDown))
With Cel
If .Offset(0, -1) = "-" Then
.Value = "-"
ElseIf VLookup(.Offset(0, -4),VRng,1 ,1) <> .Offset(0, -4) Then
.Value = "Pending..."
ElseIf .Offset(0, -4) = .Offset(-1, -4) Then
Value = .Offset(-1, 0).Value
ElseIf Lcase(.Offset(0, -1)) = "ok" Then
.Value = VLookUp(VRng, 3 0)
ElseIf LCase(.Offset(0, -1)) = "ipg" Or LCase(.Offset(0, -1)) ="bad" Then
.Value = VLookup(VRng, 3, 0) + .Offset(-1, 0)
Else: .Value = ""
End If
End With
Next Cel
End Sub
Sub test3()
Dim Cel As Range
Dim VRng As Range
Set VRng = Range("B8:D400)
For Each Cel In Range(Range("K8"),Range(K8").End(xlDown))
With Cel
.Value = ""
Select Case LCase(.Offset(0, -1) )
Case "-": .Value = "-"
Case "ok": .Value = VLookUp(VRng, 3 0)
Case "ipg", "bad": .Value = VLookup(VRng, 3, 0) + .Offset(-1, 0)
End Select
If VLookup(.Offset(0, -4),VRng,1 ,1) <> .Offset(0, -4) Then
.Value = "Pending..."
ElseIf .Offset(0, -4) = .Offset(-1, -4) Then
Value = .Offset(-1, 0).Value
End If
End With
Next Cel
End Sub
Note that the second sub was developed from the first, so If I made an error in the first, that error will be in the second. My "Office" computer is down and I can't test anything.
edit to add: For example, most of the VLookups are missing the first parameter :(
alexnkc
12-04-2013, 08:07 PM
Hi Guy,
This few day is really busy. I will test the and learn the code which posted in this forum and feedback when I am a bit free.
Thanks
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.