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
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"
I initially asked a question below.
Basically I want 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.
Realized I needed to look at the data different, as I was losing rows that I needed to stay.
New logic, which I think will still use some of the old program, but
it needed to be sorted using another column. I need the VBA to look at
column E:E. If the cell in the row below is a duplicate of the cell
above, then look at column L in that row to see if the cell says
Program. If so the cell below should be Lathe. If not lathe delete the
Program Row, If it is Lathe leave both rows. If the Cells in Column E
are not duplicates, continue looking. EX. If E5=E6, If not continue
looking. If yes Look at L5 to see if it say Program. If so look at L6
for Lathe. If not delete ROW5.
This I what I received that answered teh first question which I think will still get used
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 should do it
For i = ThisWorksheet.Cells.SpecialCells(xlCellTypeLastCell).Row to 2 step -1
' that row do you mean the duplicate or the original (I am using original)
If ThisWorksheet.Cells(i, 5) = ThisWorksheet.Cells(i-1, 5) and _
ThisWorksheet.Cells(i-1, 12) = "Program" and ThisWorksheet.Cells(i, 12) <> "Lathe"
ThisWorksheet.Rows(i-1).EntireRow.Delete
End If
Next i
When deleting it is best to iterate from last to first. If prevent you from skipping rows.
Sub RemoveRows()
Dim x As Long
With Worksheets("Sheet1")
For x = .Range("E" & .Rows.Count).End(xlUp).Row To 2 Step -1
If .Cells(x, "E").Value = .Cells(x - 1, "E").Value And Cells(x - 1, "L").Value = "Program" Then
.Rows(x).Delete
End If
Next
End With
End Sub
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 currently have a code that finds the first empty cell in a specific column and saves the result of a "SumIfs" calculation into that cell. It runs for multiple columns on multiple criteria. The example below is one instance where I search for the criteria "R" and "ECHO", sum the corresponding values from column 16, and place the result in column "C" of another worksheet:
Sub SumIfs()
Dim ws2 As Worksheet: Set ws2 = ThisWorkbook.Sheets("previous_day_split")
Worksheets("daily_balance").Activate
Range("C" & Rows.Count).End(xlUp).Offset(1, 0).Value = _
Application.SumIfs(ws2.Columns(16), ws2.Columns(15), "R", ws2.Columns(20), "ECHO")
End Sub
It works great, but now instead of just placing the result in the first empty cell of column "C", I want to find a way to designate a row (not always going to be the first empty one) based on specific dates in the first column of "daily_balance".
In short, for example, I want the code to essentially search for a date (say 11/2/2015) in the first column of the worksheet "daily_balance", designate that row as the row to dump the values into, run the SumIfs function in "ws2", and place the results in column "C" for the row containing 11/2/2015.
Any suggestions or ideas on the best way to designate a row based on criteria?
You can easily look for a specific value in a column using Do While loop:
i = 0
Do While Cells(i, "A") <> {lookup_value} And Cells(i, "A") <> ""
i = i + 1
loop
'Check that {i} holds row number for our lookup value and not for an empty one
if Cells(i, "A") = {lookup_value} then
'Do your calculations here
'And then use {i} as row number to save your result.
end if
So {lookup_value} is a constant or variable holding the date you are looking for. In case your dates are not well formated you might need to use CDate() to bring your lookup_value and cell value to the same format, meaning that instead of:
Do While Cells(i, "A") <> {lookup_value} And Cells(i, "A") <> ""
you should use:
Do While CDate(Cells(i, "A")) <> CDate({lookup_value}) And Cells(i, "A") <> ""
Good luck with that, and feel free to ask for more details.
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