PDA

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

snb
11-29-2013, 02:26 AM
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

SamT
11-29-2013, 07:53 AM
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

SamT
12-01-2013, 04:49 PM
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