Hoping I can get help here, I am currently using the Dim Long in my VBA code but since I am referring to multiple columns the code became quite long. Now, I wanted to try named range reference instead but i cannot make it work.
This is my current code:
Dim i As Long
For i = 8 To 500
'if details is incomplete
If Range("AA" & i).Value > 0 Then
If Range("AB" & i).Value = "Error" Or Range("AC" & i).Value = "Error" Or Range("AD" & i).Value = "Error" _
Or Range("AE" & i).Value = "Error" Or Range("AF" & i).Value = "Error" Or Range("AG" & i).Value = "Error" _
Or Range("AH" & i).Value = "Error" Or Range("AI" & i).Value = "Error" Or Range("AJ" & i).Value = "Error" _
Or Range("AK" & i).Value = "Error" Or Range("AL" & i).Value = "Error" Or Range("AM" & i).Value = "Error" _
Or Range("AN" & i).Value = "Error" Or Range("AO" & i).Value = "Error" Or Range("AP" & i).Value = "Error" _
Or Range("AQ" & i).Value = "Error" Or Range("AR" & i).Value = "Error" Or Range("AS" & i).Value = "Error" _
Or Range("AT" & i).Value = "Error" Or Range("AU" & i).Value = "Error" Or Range("AV" & i).Value = "Error" _
Or Range("AW" & i).Value = "Error" Or Range("AX" & i).Value = "Error" Or Range("AY" & i).Value = "Error" Then
MsgBox "One of the mandatory field is not provided, please check all cells highlighted in yellow & make sure details is provided."
End If
Endif
I named range AA = "Validation" & range AB:AY = "Details" how can i declare it and use named range instead of writing each columns one by one?
As #Ike suggests - use the COUNTIF formula. Can be used on the worksheet or within VBA. If you want to return the addresses of each error then Find might be a better route.
Sub Test()
Dim Result As Long
Result = Errors(Sheet1.Range("AB8:AY500"))
If Result > 0 Then
MsgBox "There are " & Result & " errors in the range."
End If
End Sub
Public Function Errors(Target As Range) As Long
Errors = WorksheetFunction.CountIf(Target, "Error")
End Function
Conditional formatting can handle this. I have demonstrated for a smaller range. Feel free to apply it for your required range.
NON VBA
Formula used: =AND($AA8>0,AB8="Error")
VBA
You can use conditonal formatting in VBA as well.
I have commented the code.
Option Explicit
Sub Sample()
Dim i As Long
Dim ws As Worksheet
Dim CondTrue As Boolean
'~~> Change this to the relevant sheet
Set ws = ThisWorkbook.Sheets("Sheet1")
With ws
'~~> Check if there is even one cell which satisfies our condition
For i = 8 To 500
If .Evaluate("=AND(AA" & i & ">0,COUNTIF(AB" & i & ":AY" & i & ",""Error"")>0)") = True Then
CondTrue = True
Exit For
End If
Next i
'~~> If found then apply conditional formatting
If CondTrue Then
With .Range("AB8:AY500")
.FormatConditions.Delete
.FormatConditions.Add Type:=xlExpression, _
Formula1:="=AND($AA8>0,AB8=""Error"")"
.FormatConditions(.FormatConditions.Count).SetFirstPriority
With .FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
End With
.FormatConditions(1).StopIfTrue = False
End With
'~~> Show message box
MsgBox "One of the mandatory field is not provided, please check all cells highlighted in yellow & make sure details is provided."
Else
MsgBox "All Good!"
End If
End With
End Sub
IN ACTION (VBA)
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
CODE1 has some issues. You've inserted some Chr(34) around the VLOOKUP and unless you want the cell to display the lookup formula, instead of the result of the lookup then they need to go.
ws1.Range("G" & i).Formula = "=IF(E" & i & "+ F" & i & " = 0, " & "VLOOKUP(C" & i & ",'[NOT OK.xlsx]Sheet1'!F:I,4,FALSE)" & ", " & Chr(34) & "No" & Chr(34) & ")"
To blank out zeros and #N/A -
ws1.Range("G" & i).Formula = "=IFNA(IF(E" & i & "+ F" & i & " = 0, " & "IF(IFNA(VLOOKUP(C" & i & ",'[NOT OK.xlsx]Sheet1'!F:I,4,FALSE),0)=0,"""",IFNA(VLOOKUP(C" & i & ",'[NOT OK.xlsx]Sheet1'!F:I,4,FALSE),0))" & ", " & Chr(34) & "No" & Chr(34) & "),"""")"
The first code is an easy fix: there actually is a syntax error, as vba requires spaces between variable names and the &-Operator. Adding spaces like
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) & ")"
will solve that problem.
Your current code is testing a range of values which is likely why you are getting type issues
Instead it would be easier to add the if test in the formula (Then using R1C1 notation to create referenced lookups)
.Range("G2:G" & lastrow3).FormulaR1C1 = "=IF(AND(RC[-2]=0,RC[-1]=0),IFERROR(VLOOKUP(RC[-4],'[NOT OK.xlsx]Sheet1'!C[-1]:C[2],4,FALSE),""""),"Null Values")"
Something is wrong with the nested If statements, causing the Do loop error. If I simplify my If block to one item, it works fine. (I usually work in C#.NET in VS). This is supposed to be part of a simple form in Excel to aid data entry.
Private Sub cbDelete_Click()
If tbName.Value = "" Then
MsgBox "Sorry, please navigate to a non-blank row."
Exit Sub
End If
Dim i As Integer
i = 3
Do While ThisWorkbook.Worksheets("Non-SR").Range("A" & i).Value <> ""
'MsgBox ThisWorkbook.Worksheets("Non-SR").Range("A" & i).Value
If (tbName.Value = ThisWorkbook.Worksheets("Non-SR").Range("A" & i).Value) Then
If (dpDateSubmited.Value = ThisWorkbook.Worksheets("Non-SR").Range("B" & i).Value) Then
If (tbLocation.Value = ThisWorkbook.Worksheets("Non-SR").Range("C" & i).Value) Then
If (tbBU.Value = ThisWorkbook.Worksheets("Non-SR").Range("D" & i).Value) Then
If (tbTitle.Value = ThisWorkbook.Worksheets("Non-SR").Range("E" & i).Value) Then
If (tbDescription.Value = ThisWorkbook.Worksheets("Non-SR").Range("F" & i).Value) Then
If (tbStatus.Value = ThisWorkbook.Worksheets("Non-SR").Range("G" & i).Value) Then
ThisWorkbook.Worksheets("Non-SR").Rows(i).Delete Shift:=xlUp
Exit Sub
End If
i = i + 1
Loop
MsgBox "Item not found!"
End Sub
New fixed code:
Private Sub CommandButton1_Click()
If tbName.Value = "" Then
MsgBox "Sorry, please navigate to a non-blank row."
Exit Sub
End If
Dim i As Integer
i = 3
Do While ThisWorkbook.Worksheets("Non-SR").Range("A" & i).Value <> ""
'MsgBox ThisWorkbook.Worksheets("Non-SR").Range("A" & i).Value
If (tbName.Value = ThisWorkbook.Worksheets("Non-SR").Range("A" & i).Value) And _
(dpDateSubmited.Value = ThisWorkbook.Worksheets("Non-SR").Range("B" & i).Value) And _
(tbLocation.Value = ThisWorkbook.Worksheets("Non-SR").Range("C" & i).Value) And _
(tbBU.Value = ThisWorkbook.Worksheets("Non-SR").Range("D" & i).Value) And _
(tbTitle.Value = ThisWorkbook.Worksheets("Non-SR").Range("E" & i).Value) And _
(tbDescription.Value = ThisWorkbook.Worksheets("Non-SR").Range("F" & i).Value) And _
(tbStatus.Value = ThisWorkbook.Worksheets("Non-SR").Range("G" & i).Value) Then
ThisWorkbook.Worksheets("Non-SR").Rows(i).Delete Shift:=xlUp
Exit Sub
End If
i = i + 1
Loop
MsgBox "Item not found!"
End Sub
Appreciate all the help.
-RickH
I am not quite sure yet, what you need. Still, I'd like to propose already a few changes to simplify your code block in the following way:
Private Sub cbDelete_Click()
If tbName.Value = "" Then
MsgBox "Sorry, please navigate to a non-blank row."
Exit Sub
End If
Dim i As Integer
i = 3
With ThisWorkbook.Worksheets("Non-SR")
For i = 3 To .Cells(.Rows.Count, "A").End(xlUp).Row
'MsgBox ThisWorkbook.Worksheets("Non-SR").Range("A" & i).Value
If tbName.Value = .Range("A" & i).Value And _
dpDateSubmited.Value = .Range("B" & i).Value And _
tbLocation.Value = .Range("C" & i).Value And _
tbBU.Value = .Range("D" & i).Value And _
tbTitle.Value = .Range("E" & i).Value And _
tbDescription.Value = .Range("F" & i).Value And _
tbStatus.Value = .Range("G" & i).Value Then
.Rows(i).Delete Shift:=xlUp
Exit Sub
End If
Next i
End With
MsgBox "Item not found!"
End Sub
The Do...Loop has been removed and exchanged with a For...Next
All the If statements have been combined into one
A With block has been set to speed up your code and make the code shorter.
If statements are code block.
You can have a single line If statement
VBA
If a = 10 Then do_something Else do_somthingElse
C#
if(a = 10)
do_somthingElse;
Multi-line If statements must be closed
VBA Use End If to enclose the code
If a = 10 Then
do_something
Else
do_somthingElse
End If
C# Use brackets {} to enclose the code
if(a = 10){
do_somthingElse;
else{
do_somthingElse;
}
Your code opened 7 If statement blocks an closed 1 of them
I am able to run the validation and change event trigger to work on one cell(reference here is M6). When the user select "Valid" or "Not Valid" from the dropdown list it should populate name of the user and date in adjacent columns(N6,O6), this is working fine if I am selecting the option from drop down or copying the value one cell at a time.
Somehow the macro does not work when I copy the value in multiple cells(M8:M10) at a time, nor it is working when using the autofill option to populate records in the cells of that column. Also tried to insert a non-valid data "adsadasdad
" in Cell M8, the validation worked, but when inserting non-valid data in multiple cells, validation is not working.
Please find the macro code
Private Sub Worksheet_Change(ByVal Target As Range)
Dim LastRow As Long
Set MainWB = ThisWorkbook
LastRow = MainWB.Worksheets("LDVC_data").Cells(MainWB.Worksheets("LDVC_data").Rows.Count, "A").End(xlUp).Row
For i = 2 To LastRow
If Target.Address = Range("M" & i).Address Then
If Range("M" & i) = "Valid" Or Range("M" & i) = "Not Valid" Then
ActiveSheet.Range("N" & i).Value = (Environ$("Username"))
ActiveSheet.Range("O" & i).Value = Now
ElseIf (Range("M" & i) = "[enter image description here][1]") Then
ActiveSheet.Range("N" & i).Clear
ActiveSheet.Range("O" & i).Clear
Else[enter image description here][1]
MsgBox ("Kindly enter valid value")
Range("M" & i) = ""
End If
End If
Next i
End Sub
Managed to capture the change and perform data validation in multiple cells.
Did following changes to the code.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim LastRow As Long
Set MainWB = ThisWorkbook
Dim myRange As Range
Set myRange = Target
LastRow = MainWB.Worksheets("LDVC_data").Cells(MainWB.Worksheets("LDVC_data").Rows.Count, "A").End(xlUp).Row
For Each targetCell In Target
For i = 2 To LastRow
If targetCell.Address = Range("M" & i).Address Then
If Range("M" & i) = "Valid" Or Range("M" & i) = "Not Valid" Then
ActiveSheet.Range("N" & i).Value = (Environ$("Username"))
ActiveSheet.Range("O" & i).Value = Now
ElseIf (Range("M" & i) = "") Then
ActiveSheet.Range("N" & i).Clear
ActiveSheet.Range("O" & i).Clear
Else
MsgBox ("Kindly enter valid value")
Range("M" & i) = ""
End If
End If
Next i
Next targetCell
End Sub
I am trying to use .formulaR1C1 to sum up values from different sheets on my main sheet for my workbook.
Everytime I run through my code it errors on the last bit where the formula is entered.
code:
For cRow = 9 To row
For Each WS In Worksheets
If Left(WS.Name, 5) <> "Total" Then
If Left(WS.Name, InStr(WS.Name, " ") - 1) = "December" Then
ytdSheet.Cells(cRow, 2).FormulaR1C1 = "=SUM(" & ytdSheet.Cells(cRow, 2).Value & "'" & WS.Name & "'!RC)" 'HERE IS WHERE ERROR OCCURS!!!
Else
ytdSheet.Cells(cRow, 2).Value = ytdSheet.Cells(cRow, 2).Value & "'" & WS.Name & "'!RC,"
End If
End If
Next WS
Next cRow
I feel like I am missing something simple, but I cannot figure it out.
Well I figured out why it wasn't working! my code was putting in a leading ' but in the cell, it reads it as a "Make this a text entry" so it doesn't show up in the debug.print ..
I changed my code to use an array instead of the cell to hold the string while I build it, and then use the formulaR1C1 line to output to the cell..
For cRow = 9 To row
For Each WS In Worksheets
If Left(WS.Name, 5) <> "Total" Then
If Left(WS.Name, InStr(WS.Name, " ") - 1) = "December" Then
ytdSheet.Cells(cRow, 2).FormulaR1C1 = "=sum(" & sArr(1) & "'" & WS.Name & "'!R" & cRow & "C2)" 'HERE!!!
'Debug.Print "=" & ytdSheet.Cells(cRow, 2).Value & "'" & WS.Name & "'!R" & cRow & "C2" 'HERE!!!
Else
sArr(1) = sArr(1) & "'" & WS.Name & "'!R" & cRow & "C2, "
Debug.Print sArr(1)
End If
End If
Next WS
Next cRow
works like a charm!