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 © 2020 vBulletin Solutions Inc. All rights reserved.