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
Related
I am having a difficult time coming up with a solution for a project I'm working on. I am needing a Macro to look at a specific sheet, find a specific value, and cut/paste that value at the end of the row.
Looking at the example file I have attached, you can see that each customer has a unique ID in column A.
They are answering a questionnaire, and each answer they give generates a unique ID.
The order of the answer ID's doesn't matter, as they are unique. The only one that DOES matter is the answer with Semicolons. That answer ID needs to be the customer's last ID. So I need to find a way to cut these answer ID's and paste them to the end of each row.
I want the semi-colon answer to be the last answer in the array. First time posting on here so I'm sorry if the format is incorrect.
Updated: Example File
I think that this will do what you're looking for. It goes through columns and loops through each row in those columns and once it finds a cell with a ;, it just moves that value down to the bottom of the row it was found in.
Sub AnswerID()
Dim lastCol As Long
lastCol = Cells(1, Columns.count).End(xlToLeft).Column
Dim i As Long
For i = 1 To lastCol
Dim lastRow As Long
lastRow = Cells(Rows.count, i).End(xlUp).row
Dim j As Long
For j = 1 To lastRow
If InStr(Cells(j, i), ";") > 0 Then
Cells(lastRow, i).offset(1, 0).Value2 = Cells(j, i).Value2
Cells(j, i).Value2 = vbNullString
Exit For
End If
Next j
Next i
End Sub
This process is being used for QC purposes. I have a spreadsheet that highlights certain cells that are wrong based off of their values and the validation rules we have in place. I was wonder if there was a way to return the column names of each cell that is colored into column A for each row? So for example if D2, F2, and G2 are wrong it would put all of those column headers in A2 to specify what exactly is wrong. I know it gets a bit more complicated trying to automate stuff with cell colors and I am not experienced in VBA which I'm assuming this will need. Is this possible to do, if so what would be the proper route to take? The data runs from column A to column BS, and the row numbers may differ, so if it could run up to row 1,000 that would be great. Attached is what the data looks like that I am working with.
The red means something is wrong in that row, and the orange cell is the color indicating that it is a wrong value
Yes, it is possible to do. Here is some snippets of code I pulled together to help get you started.
Lastrow = Cells(Rows.count, "A").End(xlUp).Row 'Get last row
With ActiveSheet
Lastcol = .Cells(1, .Columns.count).End(xlToLeft).Column 'Get last col
End With
For x = 1 To Lastcol 'Iterate Col
For i = 1 To Lastrow 'Iterate Row
'if red....
If Cells(i, x).Selection.Interior.Color = 255 then
'Move name to Cell A and append off of old name(s).
Cells(i, "A") = Cells(i, "A") & ", " & Cells(i, x)
End If
Next i 'next row
Next x 'next col
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'm trying to delete entire rows in Excel 2013 but only if all cells in columns K, L and M are 0/$0.00.
Example of my data:
Excel Data Sheet
I'm wanting it to keep rows 2 - 11 as they all contain something in K, L or M. The current code that I found and have been trying to use seems to only be recognising columns L and M because it is deleting row 2 which has a figure in column K. I don't want it to calculate the totals of the 3 cells in a row because if I have a figure of $500 in column K and -$500 in column L, they'll equal to $0.00 but I need that row because there is data.
I had found 2 questions very similar to what I'm asking on this site so I tried to apply the code to what I'm doing but I must have been doing something wrong because I couldn't get it to work.
Excel VBA delete entire row if both columns B and C are blank
Delete entire row if cells in specific range are all empty
This is the code that I found and have been trying to use. Could it not be working because 1 column is positive numbers and the other 2 are negative numbers? I'm really new to using VBA etc. so I'm sorry if this is something really simple.
Sub DeleteRows()
Dim rng As Range, cel As Range
Dim N As Long
For N = rng.Rows.Count To 1 Step -1
If rng.Cells(N, 1) = 0 And rng.Cells(N, 2) = 0 Then
rng.Cells(N, 1).EntireRow.Delete shift:=xlShiftUp
End If
Set rng = ActiveSheet.Range("L1:L" & ActiveSheet.Range("L" & ActiveSheet.Rows.Count).End(xlUp).Row)
If rng.Cells(N, 1) = 0 And rng.Cells(N, 2) = 0 Then
rng.Cells(N, 1).EntireRow.Delete shift:=xlShiftUp
End If
Set rng = ActiveSheet.Range("M1:M" & ActiveSheet.Range("M" & ActiveSheet.Rows.Count).End(xlUp).Row)
If rng.Cells(N, 1) = 0 And rng.Cells(N, 2) = 0 Then
rng.Cells(N, 1).EntireRow.Delete shift:=xlShiftUp
End If
Next N
End Sub
The spread sheets that I actually work with and use every day usually contain 12,000 to 15,000 rows (file size is always about 2.5MB).
I would really appreciate any help on what I could do to make this work.
Thank you
If I understand you correctly:
Sub DeleteRows()
Dim rw As Range, r
'start on the last row
With ActiveSheet.Range("A1").CurrentRegion.EntireRow
Set rw = .Rows(.Rows.Count)
End With
Do While rw.Row > 11
r = Application.CountIf(rw.Cells(1, "K").Resize(1, 3), 0)
Set rw = rw.Offset(-1, 0)
If r = 3 Then rw.Offset(1, 0).Delete
Loop
End Sub
you may want to try this code:
Option Explicit
Sub DeleteRows()
With ActiveSheet '<--| refer to active sheet (you may want to explicitly refer to a named worksheet: 'With Worksheets("mySheet")')
With .Range("A1").CurrentRegion.Offset(, .UsedRange.Columns.Count).Resize(, 1) '<--| refer to a range in a "helper" column just outside the used range occupying the same rows as your data
.FormulaR1C1 = "=if(countif(RC11:RC13,0)=3,1,"""")" '<--| use "helper" column to mark "KLM-zero's" rows with a "1", while leaving others with a "blank" mark
If WorksheetFunction.Sum(.Cells) > 0 Then .SpecialCells(XlCellType.xlCellTypeFormulas, xlNumbers).EntireRow.Delete '<--| delete any row whose "helper" column cell is marked with "1"
.Clear '<--| clear "helper" column
End With
End With
End Sub
I'm writing a code that copies data from one sheet into another and I've got that function working fine. Now, I'm trying to code it to delete any rows that contain duplicate information based off that information's ID number in column F. Part of our process is to manually enter in column E when each row has been worked.
So my end goal is for the code to delete rows where column E is blank and column F is a duplicate. My code runs, but doesn't delete anything. I'm really hoping I'm just missing something ridiculously obvious.
For i = 1 To Range("f" & Rows.Count).End(xlUp).Row
If Cells(i, 5).Value = "" Then 'if column E is blank on row i
x = Cells(i, 6).Value
If Not IsError(Application.Match(x, "F:F", 0)) Then '& if that row is a duplicate
ActiveSheet.Range(x).EntireRow.Delete 'delete new duplicate row
End If
End If
Next i
Try it with,
For i = Range("f" & Rows.Count).End(xlUp).Row to 1 Step -1
If Cells(i, 5).Value = "" Then 'if column E is blank on row i
x = Cells(i, 6).Value
If Application.Countif(Columns(6), x) > 1 Then '& if that row is a duplicate
Rows(i).EntireRow.Delete 'delete new duplicate row
End If
End If
Next i
You were trying to delete the row number x, not i. Additionally, everything was going to be matched once.
So there are a couple of errors that need to be addressed in your code. First, if you are looping over a range and deleting rows, it's best to start from the bottom and work your way up. This prevents issues where your iterator is on a row, that row gets deleted, and the loop essentially skips the next row.
Next, you are looking for a Match in column F of x, which contains a value from Column F. So, it will always return a value (itself, at the very minimum). Maybe try using a COUNTIF and seeing if it's greater than 1 may be a better option?
Next, you populated the variable x with the value in Cells(i, 6), but then you try to use it as a range when deleting. Change your code to the following and see if it works:
For i = Range("f" & Rows.Count).End(xlUp).Row To 1 Step -1
If Cells(i, 5).Value = "" Then 'if column E is blank on row i
x = Cells(i, 6).Value
If Application.Countif(Columns(6), x) > 1 Then '& if that row is a duplicate
ActiveSheet.Rows(i).Delete 'delete new duplicate row
End If
End If
Next i
Why not use the .RemoveDuplicates method? It's faster than looping around. Here's a rough outline on its use:
With Range
.RemoveDuplicates Columns:=Array(6), Header:=xlYes
End With
Here's the msdn doc for the method, and another page with a more detailed implementation. They should clear up any questions you might have.