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.
Related
I'm fairly new to VBA and I can't seem to figure this one out through google.
I'm trying to run through a worksheet and use an If statement to delete unnecessary columns, based on their row 1 values. I'm trying to do it like this:
Sub Macro1
Dim cell As Range
For Each cell In Rows("1")
If cell.Value <> "order_number", "tax_details", "etc"
Then .EntireColumn.delete
End Sub
But I can't seem to figure out how to use the "If cell.Value" statement with multiple values, nor how to delete the columns that I don't want. Any help is much appreciated.
Cheers,
Justin
Edit: Thanks for all the responses guys, everything was super helpful. Fixed the problem and I learned a lot.
You are close.
Your For loop must be ended with a Next statement
your Then must occur on the same line as your If to be valid and should be closed with an End If (unless you do a one-liner)
You must test your conditions separately with an AND separating them
Cell is already a keyword here (subclass of a Range) so change that variable to rngCell or something different.
Rows("1") would be better as an explicit range otherwise it will literally loop through every column in that row. That's a lot of columns.
Sub Macro1
Dim rngCell As Range
For Each rngCell In Range("A1:GZ1").Cells
If rngCell.Value <> "order_number" And rngCell.Value <> "tax_details" AND rngCell.Value <> "etc" Then
rngCell.EntireColumn.delete
End If
Next cell
End Sub
No other response seems to be addressing the fact that you looping left-to-right while deleting columns. Delete rows from bottom to top and delete columns from right to left or you risk skipping over cells/columns.
Sub Macro1
Dim i as long
with worksheets("sheet1")
For i=.cells(1, .columns.count).end(xltoleft).column to 1 step-1
select case lcase(.cells(1, i).value)
case "order_number", "tax_details", "etc"
'do nothing
case else
.columns(i).entirecolumn.delete
end select
next i
end with
End Sub
In order to test multiple conditions, you use logical operators(AND, OR, NOT, etc) to create a single logical statement(i.e. a single value for all 3). If you want any of the conditions to work, use "or" and if you need all 3 conditions to be met, use AND.
If cell.Value <> "order_number", "tax_details", "etc"
should be
If cell.Value <> "order_number" OR cell.value <> "tax_details" OR cell.value <> "etc" then
To delete the entire column that way, you'd need to reference which column you're trying to delete. If you're iterating over the rows, you'd access it by
Cell.EntireColumn.delete
You must compare/evaluate each time.
If cell.Value <> "order_number" And cell.Value <> "tax_details" And cell.Value <> "etc"
Thanks in advance for any help! I haven't used much VBA in excel and can't work out how to do what I need, however I believe I need it to achieve the function I need within the workbook.
I have 31 data pages, in which I need to find if certain information is present and display it on a summary page.
I need is to check if there are values in the column AQ, If there is then I need the data returned in that row in columns E, F and G.
There could be multiple instances per sheet or none per sheet.
Hopefully this will example explain it better:
E F G ... AQ
Date Name Location Exception
2 1-12-17 Dave England
3 1-12-17 Sarah Wales Exp
In the example data above the information I would want returned on the Summary page is from row 3. (This type of data is on each of the 31 other pages)
Hope this makes sense! Any help on how to do this would be greatly appreciated.
There are a number of different ways you could tackle this problem, for example, pivot tables with specific filter conditions, a UDF that finds the matches and prints them to the output you'd like, etc. In general, it's not a bad idea to use the Range.Find method and loop through all the matches.
This requires a certain amount of programming time and energy, which not everyone has, although most people who use Excel a lot eventually end up using vLookup a lot. I've always been unsatisfied with vLookup, it's so limited compared to the vba Range.Find method. Just for you, since it's almost Christmas and I ran out of work that I'm actually paid to do, here's a little gem that should help solve your problem.
It's a UDF lookup that allows you specify which number match to return, and return a custom offset in rows or column to retrieve as a value. Incrementing the variable matchNum will give you all the matches in the range, and you can return whatever columns you want using the appropriate amount of offset.
The use of the Range.Find method should give you an idea of how you could use code to populate a worksheet with exactly what you wanted without using a UDF lookup function. I'll leave that as an exercise for the reader.
'################################################################################################################################
' findwhat: the value you want to find. (needle)
' where: the range you want to look for findwhat (haystack)
' matchNum: if the needle is found more than once in the haystack, find the nth target.
' rowoffset: offset your return value from the target, positive will return the value of the cell below the target.
' columoffset: offset your return value from the target, positive will return the value of the cell to the right of the target.
'################################################################################################################################
Public Function powerLookup(findwhat As Variant, where As Range, Optional matchNum As Long = 1, Optional rowOffset As Long = 0, Optional columnOffset As Long = 0) As Variant
Dim rngResult As Range, firstAddress As String
Set rngResult = Nothing
On Error GoTo Errorhandler ' if something breaks return #NA (will definitely happen if first find call fails)
Do While matchNum > 0 'loop through the matches until there are no matches or we've reached the target matchnumber
'the first time, rngResult will be Nothing, so the first find can't have rngResult as an input.
With where
If rngResult Is Nothing Then
Set rngResult = .find(findwhat, , xlValues)
firstAddress = rngResult.Address 'keep this to know if we've looped past the start
Else
'if rngResult is not nothing we've already found a match, find the next match until matchnum is 0
Set rngResult = .find(findwhat, rngResult, xlValues)
If rngResult.Address = firstAddress Then
'if we reach the first address we've looped around, no more matches found, throw #NA error
powerLookup = CVErr(xlErrNA)
Exit Function
End If
End If
End With
matchNum = matchNum - 1
Loop
powerLookup = rngResult.offset(rowOffset, columnOffset).Value 'offset the output
Exit Function
Errorhandler:
powerLookup = CVErr(xlErrNA)
End Function
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
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 an interesting issue. I've tried searching this site and Google but there are only slightly related problems, none which actually address this specific need.
I have a spreadsheet with 10 columns (let's call them A-J). I need to delete all the rows that do NOT have a value of "30", "60", "90", "120" or blank within the cells of column H.
Though there are many ways of doing this, all of them have relied on loops, which doesn't work for me as this dataset has over 25k rows and it takes 10+ minutes to run - too long.
I've been looking at autofilter options in conjunction with the .Find function (e.g. find all rows with H cells that don't meet the criteria and delete) but AutoFilter on 2003 only works with 2 criteria, while I have 5 to check against. I'm not sure how to proceed.
Any help is appreciated.
This deleted all matching rows (~10%) in a sample of 25k rows in 20sec
Sub tt()
Dim rw As Range
Dim all As Range
Dim t
Dim b As Boolean
t = Timer
For Each rw In Range("A1").CurrentRegion.Rows
If rw.Cells(8).Value < 1 Then
If b Then
Set all = Application.Union(rw, all)
Else
Set all = rw
b = True
End If
End If
Next rw
If not all is nothing then all.EntireRow.Delete
Debug.Print "elapsed: " & Timer - t
End Sub
You can try Advanced Filter option where you can give more than two criteria to filter the list. After filtering the list matching the criteria you set, the filtered list can be copied to another location (option available) and the remaining deleted.
You can add a column with the condition of your own:
=IF(OR(H1=30;H1=60;H1=90;H1=120;H1="");"DELETE";"")
(the formula is given for row 1, you have to copy-paste it to the entire range)
Then use filtering and sorting to select the rows to delete.
Some speed tips:
When using large data, assign values to array and use array instead of *.Value;
When working with full columns, ignore empty columns at bottom;
When making intensive changes in worksheet, disable screen update and automatic calculation.
Stating this, I would use this code:
Sub Macro1()
Dim su As Boolean, cm As XlCalculation
Dim r As Long, v(), r_offset As Long
su = Application.ScreenUpdating
Application.ScreenUpdating = False 'Disable screen updating
cm = Application.Calculation
Application.Calculation = xlCalculationManual 'Disable automatic calculation
'Only use used values
With Intersect(Range("H:H"), Range("H:H").Worksheet.UsedRange)
v = .Value 'Assign values to array
r_offset = .Row - LBound(v) 'Mapping between array first index and worksheet row number
End With
'Check all row from bottom (so don't need to deal with row number changes after deletion)
For r = UBound(v) To LBound(v) Step -1
Select Case v(r, 1)
Case "30", "60", "90", "120", Empty 'Do nothing
Case Else
Sheet1.Rows(r + r_offset).EntireRow.Delete
End Select
Next
Application.ScreenUpdating = su 'Restore screen updating
Application.Calculation = cm 'Restore calculation mode
End Sub
Thanks to all who've suggested solutions. In the between time I ended up figuring out a way to do this in <1 second - apparently I myself didn't realise that AutoFilter could've supported comparison criteria (greater than, less than etc).
Using a series of autofilters I simply filtered for, then deleted all rows that filtered to "<30", "30120".
Not elegant, but it did the trick.