lundi 16 juillet 2018

Combine If statement with Vlookup

I am trying to combine a vlookup formula with an If condition. To be more exact, I have a worksheet where I want a vlookup formula to be executed in the cell of the column G if the cell of the column E AND F is 0. Just to be clear, the variable lastrow3 and ws1 are WELL defined and have proper values. Also, I have run the code without the if condition (just the vlookup) and it runs just fine. So there is no chance that there is an issue with these variables. Moreover, I want the vlookup to be dynamic. I have written 4 different types of code. I am providing them below.

CODE1

For i = 2 To lastrow3
ws1.Range("G" & i).Formula = "=IF(E" & i & "+ F" & i & " = 0, " & Chr(34) & "VLOOKUP(C"&i&",'[NOT OK.xlsx]Sheet1'!F:I,4,FALSE)" & Chr(34) & ", " & Chr(34) & "No" & Chr(34) & ")"
Next i

This code gives me an error in this part: "VLOOKUP(C"&i&",saying that there is a syntax error.

CODE2

For Each cell In ws1.Range("G2:G" & lastrow3)
    If cell.Offset(0, -1).Value = 0 Then
        If cell.Offset(0, -2).Value = 0 Then
        cell.Formula = "=IFERROR(VLOOKUP(C2,'[NOT OK.xlsx]Sheet1'!F:I,4,FALSE),"""")"
        End If
    End If
Next cell

This code gives an error in this part: If cell.Offset(0, -1).Value = 0 Then saying that there is type mismatch. Also, this code does not have dynamic vlookup, so it vlookups only for cell C2.

CODE3

With ws1
   For i = 2 To lastrow3
       If .Cells(i, "E").Value2 = 0 And .Cells(i, "F").Value2 = 0 Then
       .Cells(i, "G").Formula = "=IFERROR(VLOOKUP($C$" & i&",'[NOT OK.xlsx]Sheet1'!F:I,4,FALSE),"""")"
       End If
   Next cell
End With

This code gives me an error in this part : .Cells(i, "G").Formula = "=IFERROR(VLOOKUP($C$" & i&",'[NOT OK.xlsx]Sheet1'!F:I,4,FALSE),"""")" saying the there is a syntax error.

CODE4

With ws1
    .Range("G2:G" & lastrow3).Formula = "=IFERROR(VLOOKUP(C2,'[NOT OK.xlsx]Sheet1'!F:I,4,FALSE),"""")"
    .Range("G2:G" & lastrow3).Value = .Range("G2:G" & lastrow3).Value
End With

This code runs fine (this is the code I ran and verified that the variables are well defined) bit does not include the If condition. I want to declare that this code runs really fast (with the With ws1 and End With) so if it is possible to make this code ran by adding the if condition then it would be perfect.

CODE5 (-> my attempt at adding If condition in CODE4)

With ws1
If  .Range("G2:G" & lastrow3).Offset(0, -1).Value = 0 And .Range("G2:G" & lastrow3).Offset(0, -2).Value = 0 Then
    .Range("G2:G" & lastrow3).Formula = "=IFERROR(VLOOKUP(C2,'[NOT OK.xlsx]Sheet1'!F:I,4,FALSE),"""")"
End If
    .Range("G2:G" & lastrow3).Value = .Range("G2:G" & lastrow3).Value
End With

This code gives me an error in this part : If .Range("G2:G" & lastrow3).Offset(0, -1).Value = 0 And .Range("G2:G" & lastrow3).Offset(0, -2).Value = 0 Then saying that there is an type mismatch.

SUMMARY

I am trying to combine speed and accuracy in the code. The code with the With and End With, from what I have searched, is the fastest. However, If I manage to solve it with another code then no issue. The main errors I get is in the vlookup formula, when I try to make it dynamic and in the if condition, when I try to find whether the offsets have 0 values.

I am adding the entire code so far (although I think it is not important)

ENTIRE CODE

Sub Pharma_Stock_Report()



Dim StartTime As Double
Dim SecondsElapsed As Double
StartTime = Timer



Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False

Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim ws3 As Worksheet
Dim lastrow1 As Long
Dim lastrow2 As Long
Dim lastrow3 As Long
Dim CopyRange As Range
Dim i As Long

spath1 = Application.ThisWorkbook.Path & "\Pharma replenishment.xlsm"
spath2 = Application.ThisWorkbook.Path & "\NOT OK.xlsx"
Workbooks.Open spath1
Workbooks.Open spath2

Set ws1 = Workbooks("Pharma Stock Report.xlsm").Worksheets("Pharma Stock Report")
Set ws2 = Workbooks("Pharma replenishment.xlsm").Worksheets("Replenishment")
Set ws3 = Workbooks("NOT OK.xlsx").Worksheets("Sheet1")

With ws1
    .Cells.Clear
End With

With ws2
lastrow1 = .Range("A" & Rows.Count).End(xlUp).Row
    For i = 4 To lastrow1
        If .Cells(i, "D").Interior.ColorIndex = -4142 Or .Cells(i, "D").Interior.ColorIndex = 2 Then
            If CopyRange Is Nothing Then
                Set CopyRange = .Range("A" & i & ":F" & i)
            Else
                Set CopyRange = Union(CopyRange, .Range("A" & i & ":F" & i))
            End If
        End If
    Next i
End With

CopyRange.Copy
With ws1.Range("A2")
    .PasteSpecial xlPasteValues
End With

ws2.Range("A4:F4").Copy
With ws1.Range("A1")
    .PasteSpecial xlPasteValues
End With

Application.CutCopyMode = False
Workbooks("Pharma replenishment.xlsm").Close

ws3.Range("I1").Copy
With ws1.Range("G1")
    .PasteSpecial xlPasteValues
End With

lastrow3 = ws1.Range("D" & Rows.Count).End(xlUp).Row

With ws1
    .Range("G2:G" & lastrow3).Formula = "=IFERROR(VLOOKUP(C2,'[NOT OK.xlsx]Sheet1'!F:I,4,FALSE),"""")"
    .Range("G2:G" & lastrow3).Value = .Range("G2:G" & lastrow3).Value
End With

Application.CutCopyMode = False
Workbooks("NOT OK.xlsx").Close

With ws1.Range("A1:G" & lastrow3)
    .HorizontalAlignment = xlCenter
    .Font.Color = vbBlack
    .Font.Name = "Calibri"
    .Font.Italic = False
    .Borders.LineStyle = xlDouble
    .Borders.Weight = xlThin
    .Borders.Color = vbBlack
End With

With ws1.Range("A1:G1")
    .Interior.ColorIndex = 41
    .Font.Bold = True
    .Font.Size = 14
    .Font.Italic = True
End With

With ws1.Range("A1", Range("A1").End(xlDown).End(xlToRight))
    .EntireColumn.AutoFit
End With

ws1.Range("A1:G1").AutoFilter
ws1.AutoFilter.Sort.SortFields.Add Key:=Range("B1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ws1.AutoFilter.Sort
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.DisplayAlerts = True



SecondsElapsed = Round(Timer - StartTime, 2)
MsgBox "This code ran successfully in " & SecondsElapsed & " seconds", vbInformation



End Sub

Aucun commentaire:

Enregistrer un commentaire