Help to reduce the VBA code length

[alexnkc]

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]

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]

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]

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]

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]

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]

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]

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]

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