I'm used to python syntax where to check if 7 is in list1 you simply type 7 in list1 and it returns a boolean. How can I perform something like this in vba?
I'm currently looping through a large range. I want to occasionally check if a value i'm looping over is in a different range. This could get much slower if I had to nest more loops into my loops. What's the fastest way to approach this problem?
For i = 400 To 1 Step -1:
'doing other things
'here's some psuedo-code of what I want to do
If Sheets("Sheet2").Cells(i, 2).Value In Sheets("Sheet1").Range("NamedRange")
Sheets("Sheet2").Cells(i, 2).EntireRow.Delete
End If
Next i
Use a countif, if it's greater than zero then you know it exists in the list:
If Application.WorksheetFunction.CountIf(Sheets("Sheet1").Range("NamedRange"), Sheets("Sheet2").Cells(i, 2).Value) > 0 Then
Sheets("Sheet2").Cells(i, 2).EntireRow.Delete
End If
Here is how you can achieve it in just one line
If Not IsError(Application.Match(ValueToSearchFor, RangeToSearchIn, 0)) Then
// Value found
End If
Example:
Search for Blah-Blah in column A of Sheet5
If Not IsError(Application.Match("Blah-Blah", Sheets("Sheet5").Range("A:A"), 0)) Then
'The value present in that range
End If
Related
I have this cell.Offset(0, -2) cell that I need to check if it exists inside my VBA loop.
My idea is that if the cell has an .Offset(0, -2) that does not exist (e.g. say cell = Column B and cell.Offset(0, -2) = Column A-1, cell.Offset(0, -2) is supposed to be invalid), I want to be able to check that it doesn't exist in the if else statement.
Right now when it doesn't exist, I'm getting a “Runtime Error 1004: Application defined or object defined error”.
I've tried IsErr(cell.Offset(0, -2)), cell.Offset(0, -2).Value, If cell.Offset(0, -2) Is Nothing Then, cell.Offset(0, -2) = "", but none of them seem to work... can anyone point me in the right direction? I'm pretty new to VBA and it seems like different variable types have different ways of checking if the value exists.
If you can use your offset amount as a variable, or some method to evaluate against the cell's column, you don't need to defend against errors. Consider below...
Sub IsvalidARea()
Dim OffsetAmount As Integer: OffsetAmount = -2
Dim Cell As Range
If Cell.Column + OffsetAmount < 1 Then
MsgBox "Oh FALSE!"
Else
'EVERYTHING IS OKAY!
End If
End Sub
A solution for this is by using the constantly misused On Error Resume Next, coupled with a If IsError. Here's an example:
On Error Resume Next
If IsError(ActiveCell.Offset(, -2).Select) = True Then
'This is indicative of an error. Meaning you are on Column B, and you ran out of space.
Else
'This means an error did not occur. Meaning you were at least on Column C or above.
End If
There may be a better solution, in fact I am sure there is. But what this will do is allow you to move past the actual 1004 Application error, and you can actually identify, and use the error that was really returned, instead of just forcing your macro/script to end.
To avoid using the error check, you can always check the current column index (B is 2) and make sure whatever you are offsetting by, once subtracted by your index is greater than 0. For example, column B is 2. Your offset is 2. 2 - 2 = 0, so it should not attempt it. Column C is 3, 3 - 2 = 1, which is greater than 0 so it would be valid. Both are explorable methods.
I am a bit new to using VBA. I have a data table, that pulls data in from one of the programs I use, and is filtered through Microsoft Query. There is one column I can't sort, so I need to use an if and statement to remove unwanted data. I came up with this if statement, which highlights the rows I want to delete, but I don't know how to put it into VBA.
=IF(L5="Program",L6<>"lathe"),"2","")
Basically I want the VBA to look at Column L:L. If the cell=program, and the cell below does not equal lathe I want the row above to be deleted. If the cell doesn't equal program continue looking until the end of the data.
In VBA, you'd use the IF ... And ... Then structure, thus:
If Range("L5")="Program" And Range("L6") <> "lathe" Then
'Do something
End If
You'll probably want to replace the Range(...) statements with a range variable of some sort to store the cells you're really interested in, but that should give you an idea of the structure you're looking for.
EDITED TO ADD:
Loop through all of column L like this:
Dim rngCheck as Range
Dim rngCell as Range
Set rngCheck = Range("L1", "L" & Rows.Count - 1)
For each rngCell in rngCheck
If rngCell.value = "Program" And rngCell.offset(1,0).value <> "lathe" then
rngCell.offset(-1,0).EntireRow.Delete
End if
Next rngCell
This:
Creates a range to look at (column L)
Loops through all cells in that column (the For each loop)
Runs our IF logic and
...deletes the entire row if the logic is met.
Here is your idea behind it. you will just need to fix the format as you'd like.
If cells(5, "L") = "Program" AND cells(6, "L") <> "Lathe" Then
cells (6, "M") = 2
Else
cells (6, "M") = ""
EndIf
The best is to loop on column L. Imagine your data is from row 3 to 150
for i = 3 to 150
if lcase(range("L"&i).value) = "program" and lcase(range("L"&i+1).value) <> "lathe" then
rows(i).entirerow.delete
end if
next i
I am having issues with this code whereby the columns still display despite not meeting the IF condition:
If CBool(Application.WorksheetFunction.CountIf(.Columns(j), "<>0"))
The code loops through columns and only displays columns that have values > 0. I do not know if the issue is with j or with the CBool condition itself. I would like some help as I really need this code for my excel as it would be then much easier and useful to analyze! Thank you.
Sub TestPasteColumnData3()
Dim lastcol As Long
Dim j As Long
With Worksheets("WF - L12 (3)")
lastcol = .Cells(5, Columns.Count).End(xlToLeft).Column
For j = 3 To lastcol
'change >0 to <>0 and 3 to j
If CBool(Application.WorksheetFunction.CountIf(.Columns(j), "<>0")) Then
.Columns(j).Copy Destination:=Worksheets("Sheet 1").Columns(j) 'Dont delete, this code works
Else
MsgBox ("No Value")
Exit Sub
End If
Next
End With
MsgBox ("Done")
End Sub
The CountIf function will count ANYTHING, including blank cells, in the range if it is not equal to 0, which will cause your
CBool(Application.WorksheetFunction.CountIf(.Columns(j), "<>0"))
to be TRUE if you have anything other than a column full of 0's (with no blanks)
You might try
If Application.WorksheetFunction.Sum(.Columns(j)) > 0 Then
.Columns(j).Copy Destination:=Worksheets("Sheet 1").Columns(j) 'Dont delete, this code works
Else
MsgBox ("No Value")
Exit Sub
End If
which will give you any column that has anything that is greater than 0, but still account for any blanks (or otherwise) you may have in the column.
WorksheetFunction.CountIf will return a count of cells that satisfy a given condition. You're converting that count to a Boolean - that will evaluate to True for any non-zero result.
You need to compare that count to something e.g. > 0 to result in a Boolean expression (then you can remove the CBool) to achieve the expected result.
If Application.WorksheetFunction.CountIf(.Columns(j), "<>0") > 0 Then
But then, if any non-zero integer converts to True, this code is equivalent (albeit less explicit about what it's doing):
If CBool(Application.WorksheetFunction.CountIf(.Columns(j), "<>0")) Then
Therefore, that condition cannot be the problem.
You need to place a break point (F9) before the loop, run the code, and step through (F8) to see what's going on. The problem might be with the usage of WorksheetFunction.CountIf against your specific worksheet data.
I'm attempting to use a Scripting Dictionary in a way as to be able to find and ultimately highlight same values or groups of same values where there are inconsistencies (ie blanks or different values in between the two same values or groups of same values). Normally these same values will repeat, but what I'm trying to catch is when they do not repeat together (See example image below taken from my previous post).
Some context that will hopefully help this make a little more sense:
This is a follow-up of sorts to one of my previous questions here. I have a conditional formatting formula:
=NOT(AND(IFERROR(COUNTIF(OFFSET(A1,0,0,-COUNTIF($A$1:$A1,A2)),A2),0)=IFERROR(COUNTIF($A$1:$A1,A2),0),IFERROR(COUNTIF(OFFSET(A3,0,0,COUNTIF($A3:$A$5422,A2)),A2),0)=IFERROR(COUNTIF($A3:$A$5422,A2),0),A2<>""))
Which works perfectly. However, in my tinkering after receiving this formula as the answer to that previous question I realized that using conditional formatting of any sort for the amount of data I typically deal with (15000+ rows with 140 consistent columns) is an extremely slow endeavor, both when applying the formula and when filtering/adjusting afterwards. I've also tried applying this formula via the "helper column" route, but to no surprise, that is just as slow.
So, where I'm at now:
Essentially, I'm trying to translate that formula into a piece of code that does the same thing, but more efficiently, so that's where I starting thinking to use a Scripting Dictionary as a way to speed up my code execution time. I have the steps outlined, so I know what I need to do. However, I feel as though I am executing it wrong, which is why I'm here to ask for assistance. The following is my attempt at using a Scripting Dictionary to accomplish highlighting inconsistencies in Column A (my target column) along with the steps I figured out that I need to do to accomplish the task:
'dump column A into Array
'(Using Scripting.Dictionary) While cycling through check if duplicate
'IF duplicate check to make sure there is the same value either/or/both in the contiguous slot before/after the one being checked
'If not, then save this value (so we can go back and highlight all instances of this value at the end)
'Cycle through all trouble values and highlight all of their instances.
Sub NewandImprovedXIDCheck()
Dim d As Long, str As String, columnA As Variant
Dim dXIDs As Object
Application.ScreenUpdating = False
Set dXIDs = CreateObject("Scripting.Dictionary")
dXIDs.comparemode = vbTextCompare
With ActiveSheet
With .Cells(1, 1).CurrentRegion
With .Resize(.Rows.Count - 1, .Columns.Count).Offset(1, 0)
'.Value2 is faster than using .Value
columnA = .Columns(1).Value2
For d = LBound(columnA, 1) To UBound(columnA, 1)
str = columnA(d, 1)
If dXIDs.exists(str) Then
'the key exists in the dictionary
'Check if beside its like counterparts
If Not UBound(columnA, 1) Then
If (str <> columnA(d - 1, 1) And str <> columnA(d + 1, 1)) Or str <> columnA(d - 1, 1) Or str <> columnA(d + 1, 1) Then
'append the current row
dXIDs.Item(str) = dXIDs.Item(str) & Chr(44) & "A" & d
End If
End If
Else
'the key does not exist in the dictionary; store the current row
dXIDs.Add Key:=str, Item:="A" & d
End If
Next d
'reuse a variant var to provide row highlighting
Erase columnA
For Each columnA In dXIDs.keys
'if there is more than a single cell address, highlight all
If CBool(InStr(1, dXIDs.Item(columnA), Chr(44))) Then _
.Range(dXIDs.Item(columnA)).Interior.Color = vbRed
Next columnA
End With
End With
End With
dXIDs.RemoveAll: Set dXIDs = Nothing
Application.ScreenUpdating = True
End Sub
I feel like my logic is going wrong somewhere in my code execution, but can't seem to pinpoint where or how to correct it. Any help would be greatly appreciated. If you can provide any sort of code snippet that would also be a great help.
Here's one approach:
Sub HiliteIfGaps()
Dim rng As Range, arr, r As Long, dict As Object, v
Dim num As Long, num2 As Long
Set dict = CreateObject("scripting.dictionary")
With ActiveSheet
Set rng = .Range(.Range("A2"), .Cells(.Rows.Count, 1).End(xlUp))
End With
arr = rng.Value
For r = 1 To UBound(arr, 1)
v = arr(r, 1)
If Len(v) > 0 Then
If Not dict.exists(v) Then
num = Application.CountIf(rng, v) 'how many in total?
'all where expected?
num2 = Application.CountIf(rng.Cells(r).Resize(num, 1), v)
dict.Add v, (num2 < num)
End If
If dict(v) Then rng.Cells(r).Interior.Color = vbRed
Else
'highlight blanks
rng.Cells(r).Interior.Color = vbRed
End If
Next r
End Sub
EDIT: every time a new value is found (i.e. not already in the dictionary) then take a count of how many of those values in total there are in the range being checked. If all of those values are contiguous then they should all be found in the range rng.Cells(r).Resize(num, 1): if we find fewer than expected (num2<num) then that means the values are not contiguous so we insert True into the dictionary entry for that value, and start highlighting that value in the column.
#Tim Williams's approach did the job perfectly! I only made one slight alteration (to suit my needs). I changed
.Cells(.Rows.Count, 1).End(xlUp) to .Range("A" & .UsedRange.Rows.count)
Just because there are instances where the bottom-most row(s) might have missing values (be blank) and in this instance I feel safe enough using the .UsedRange reference because this snippet of code is one of the very first ones ran in my overall macro, so it (.UsedRange) is more likely to be accurate. I also added a Boolean operator (xidError, set to False) to be changed to True whenever we have to highlight. After I'm done looping through the Array I check xidError and if True I prompt the user to fix the error, then end the entire macro since there's no use in continuing until this particular error is corrected.
If xidError Then
'Prompt User to fix xid problem
MsgBox ("XID Error. Please fix/remove problematic XIDs and rerun macro.")
'Stop the macro because we can't continue until the xid problem has been sorted out
End
End If
Again, much thanks to Tim for his very efficient approach!
I have a little problem, I occasionally bump into this kind of problem, but I haven’t found a fast solution so far.
So, imagine we have an Excel worksheet and let's suppose that we have a couple of numbers in column ’A’ with some empty cells in it. Altogether (just to make it simple) we have the first 10 cells in column 'A' to observe. For example:
3
(empty cell)
(empty cell)
6
(empty cell)
4
(empty cell)
23
(empty cell)
2
Now in the next step I would like to collect these numbers into another column (for example, column ’B’) using VBA. Obviously I just want to collect those cells which contain a number and I want to ignore the empty cells. So I would like to get a column something like this:
3
6
4
23
2
I have already written the following code, but I’m stuck at this point.
Sub collect()
For i = 1 To 10
if cells(i,1)<>"" then...
Next i
End Sub
Is there an easy way to solve this problem?
Probably the quickest and easiest way is to use Excel's Advanced Filter - the only amendment you'll need to make is it add a field name and criteria. You can even list unique items only:
The VBA equivalent is
Sub test()
With Sheet1
.Range("B1:B8").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=.Range( _
"D1:D2"), CopyToRange:=.Range("F1"), Unique:=False
End With
End Sub
You should be able to use the method in the post int the comments, but you could also use SpecialCells like Range("A:A").SpecialCells(xlCellTypeConstants,xlNumbers).Copy to get all of the filled cells.
Edit: needed constants not formulas.
This will work for any number of rows that you select. It will always output in the next column at the start of your selection e.g. if data starts in B10 it will ooutput in C10
Sub RemoveBlanks()
Dim cl As Range, cnt As Long
cnt = 0
For Each cl In Selection
If Not cl = vbNullString Then
Cells(Selection.Cells(1, 1).Row, Selection.Cells(1, 1).Column).Offset(cnt, 1) = cl
cnt = cnt + 1
End If
Next cl
End Sub
If you wish to loop manually and don't mind specifying the maximum row limit;
Dim i As long, values As long
For i = 1 To 10
If cells(i, 1).Value <> "" Then
values = (values + 1)
' // Adjacent column target
cells(values, 2).value = cells(i, 1).value
End If
Next i