I am using a loop to find cells with a "0" entry in column B and then delete the entire corresponding rows.
Unfortunately, I am not able to write it so it only works for one specific worksheet. Here's what I got so far:
Dim myloop
For myloop = Range("B10000").End(xlUp).Row To 1 Step -1
If Cells(myloop, 4).Value = 0 Then Rows(myloop).EntireRow.Delete
Next myloop
I want this loop specifically to run only for worksheet 2 but not my entire code to run only in worksheet 2 as this loop is just part of a bigger code.
Any help is appreciated and thanks in advance.
You need to fully qualify your Range with a certian Worksheet.
Note: you could use the AutoFilter as well, works faster for large data.
With Worksheets("Sheet1") ' <-- modify "Sheet1" to your sheet's name
For myloop = .Range("B10000").End(xlUp).Row To 1 Step -1
If .Cells(myloop, 4).Value = 0 Then .Rows(myloop).EntireRow.Delete
Next myloop
End With
Alternative: to get the last row with data in Column B (if the data will be more than 10,000 rows)
With Worksheets("Sheet1") ' <-- modify "Sheet1" to your sheet's name
For myloop = .Range("B" & .Cells(.Rows.Count, "B")).End(xlUp).Row To 1 Step -1
If .Cells(myloop, 4).Value = 0 Then .Rows(myloop).EntireRow.Delete
Next myloop
End With
if the block of code is within a bigger loop looping through worksheets, Add a if condition (activesheet.index= 2) or just check if the activesheet is sheet2 or if its just a seperate loop then specify the sheet in the code
Related
I have a workbook with 2 sheets that contain some of the same data. The first column in both worksheets contain a number assigned to an item, but sheet 2 contains more items
than sheet 1. Sheet 1 contains the items pertinent to me, so I am trying to copy the relevant data from sheet 2 into sheet 1.
For example:
Sheet 1
Column A
20
53
120
500
1123
etc
Sheet 2
Column A
1
2
3
4
5
etc
If the number in column A matches for both spreadsheets, I need to copy cell M from sheet 2 to cell I in sheet 1. I have tried a few different solutions posted elsewhere, but
since my data isn't ideally sorted between the two sheets, using things like VLookup wasn't working well.
I believe I need to store the information in column A in both sheets to an array and compare the data from there, I just have no clue how to write the code to continue
comparing the cell from sheet 1 until it finds a match in sheet 2, and then copy the data over.
Any help I can get would be greatly appreciated. Thanks everyone.
My current code:
Sub CopyFromSheet2()
Dim i As Long
Dim j As Long
Dim Range1 As Range
Dim Range2 As Range
Set Range1 = Sheets("Sheet1").Range("A:A")
Set Range2 = Sheets("Sheet2").Range("A:A")
For j = 1 To Range1
For I = 1 To Range2
If Sheets("Sheet1").Cells(i, "A").Value = Sheets("Sheet2").Cells(j, "A").Value Then
Sheets("Sheet1").Cells(i,"I").Value = Sheets("Sheet2").Cells(j, "M").Value
End If
Next i
Next j
End Sub
I am currently getting run time error 13 on the For j = 1 to Range1 line "Type mismatch"
Something to start with would be a loop from row 1 to last row in sheet 1, then for each of these rows, compare value of cell 1 to each value in sheet 2.
A way to compare them to each other would be like this:
If Sheets("sheet 1").Cells(i, "A").Value = Sheets("sheet 2").Cells(j, "A").Value Then
now you just need to put a nested loop around this and you are good to go.
To copy column m to i:
Sheets("sheet 1").Cells(i, "I").Value = Sheets("sheet 2").Cells(j, "M").Value
Now try out something and feel free to ask again if you are running into an error
So I ended up consolidating the columns I need into 1 spreadsheet to make things easier, and I found this question on SO: Comparing two columns, and returning a specific adjacent cell in Excel which was very similar to what I was trying to do. The formula
=IFERROR(VLOOKUP(C1, A:B, 2, 0), "")
worked perfectly for me, so I am using that instead of the VBA scrip.
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 have a report that I pull everyday that is placed in a very awekward format. It's contains a variable row count by 4 columns organized into unofficial tables based on the Name of each employee.
What I have is an employee name in column B preceded 2 blank rows above and followed by 1 blank row of data below.
What I want to accomplish is loop through the data, identify cells in column B <> blank, delete the entire 2 rows below that cell, and delete the entire 1 row above that cell.
Below is what I have so far. not much:
Sub test()
Dim currentSht As Worksheet
Dim startCell As Range
Dim lastRow As Long
Dim lastCol As Long
Dim i as integer
Set currentSht = ActiveWorkbook.Sheets(1)
Set startCell = currentSht.Range("A1")
lastRow = startCell.SpecialCells(xlCellTypeLastCell).Row
lastCol = startCell.SpecialCells(xlCellTypeLastCell).Column
For i = lastRow To 1
If Cells(i, "B").Value <> "" Then
End Sub
without making major changes to your code, try this:
For i = lastRow To 1 Step - 1
If Cells(i, "B").Value <> "" Then
Range(Cells(i, "B").Offset(1), Cells(i, "B").Offset(2)).EntireRow.Delete 'delete two below
Cells(i, "B").Offset(-1).EntireRow.Delete ' delete one above
You already get to your non-blank cell (ie Cells(i,"b")). To reference a range in relation to a cell you already have, use OFFSET.
So, and in this order, you select a range of cells from one below your cell Offset(1) to two cells below Offset(2)'. Change this range toENTIREROW` for those cells, and delete.
Then you select the cell above Offset(-1), select the ENTIREROW and delete.
as per your question narrative you'd possibly need to delete all rows that has a blank cell in column "B"
should that be the issue than you could (disclaimer: test it on a copy sheet!) simply go like follows:
Sub test()
With ActiveWorkbook.Sheets(1)
.Range("A1", .Cells(.Rows.Count, "A").End(xlUp)).Offset(, 1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With
End Sub
I have 2 sheets within the same workbook. In worksheet A called "sheet1" and worksheet B called "sheet2". From column A of sheet 1 there are upto 176080 records of duplicate ID numbers. Need to find the unique ID numbers from this column and paste it into column A of sheet 2.
Any help would be appreciated, I am new to VBA macro and found some codes online but do not understand it. Please help me and kindly provide a syntax to solve this with some explanation so I could learn how to do it on my own as well. Thanks!!
May be a little complicated, but this gives back the unique numbers in column "A".
Option Explicit
Dim i, j, count, lastrow As Integer
Dim number As Long
Sub find_unique()
lastrow = Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row
For i = 1 To lastrow
number = Cells(i, 1)
For j = 1 To lastrow
If number = Cells(j, 1) Then
count = count + 1
End If
Next j
If count = 1 Then
Cells(i, 5) = number
Else
Cells(i, 5) = ""
End If
count = 0
Next i
End Sub
First the sub takes cell A1 then loops through all other cells, starting at the first, to the last cell in the active Sheet. If a number is equal to more than one cell (it's allways one, because u also check the cell with it's own value) the number will not be displayed in column E. Then it takes the next number and loops through all again until every number is checked. Small changes and the numbers will be shown in the other sheet. Hope it works for you.
I've been looking around everywhere. But I don't know what words to google.
I want to remove every row where the cell in the C column doesn't contain 7 or 8 numbers. The problem is that I don't know how to code this.
What is the symbol in VBA code for 1 letter, 1 number, 1 or more letters, 1 or more numbers, space etc? I have been googling for hours but I guess I just don't know the right search words. Where or how can I find this? It's pretty dumb I know.
Thanks a lot.
EDIT:
#eirikdaude Thank you for your answer.
Somehow it doesn't work. This is what I have:
Dim lastRow As Long
lastRow = Cells(Rows.Count, 3).End(xlUp).Row
Dim i As Integer
For i = 2 To lastRow
If (IsNumeric(Cells(i, 3).Value) And Len(Cells(i, 3).Value) >= 7 And Len(Cells(i, 3).Value) <= 8) Then
' do nothing
Else
Rows(i).Select
Selection.Delete Shift:=xlUp
End If
Next i
I've been trying everything, but I don't understand why this code above doesn't work.
Does it matter that all my cells are formatted "standard" in excel? Because all data is imported from a txt file.
Unless you insist on using a regex for this, I'd simply check for the length of the value in the cell and if it IsNumeric.
In your case, something like this:
For Each c In rangeToCheck
If IsNumeric(c) And Len(c) >= 7 And Len(c) <=8) Then
do your stuff
End If
Next c
There two probably reason for which you code is no deleting the expected rows:
Expected lines to be deleted may be skipped by the code as it's deleting rows from top to bottom. When deleting several rows the correct method is to do it upwards (i.e. from bottom to top)
As your data is imported from a text file it's possible that values in column C have some extra blank spaces at the end. The use of TRIM takes care of this situation.
The code below includes both corrections:
Sub Rng_Delete_Rows()
Dim LRowLst As Long, LRow As Long
Dim vCllVal As Variant
'Change SheetName as required
With ThisWorkbook.Sheets(1) 'Use this if procedure resides in Data workbook
'With ThisWorkbook.Sheets(1) 'Use this if procedure does not reside in Data workbook
Application.Goto .Cells(1), 1
LRowLst = .Cells(.Rows.Count, 3).End(xlUp).Row
For LRow = LRowLst To 2 Step -1
Rem Get Cell Value At Once
vCllVal = Trim(.Cells(LRow, 3).Value2)
If Not ((IsNumeric(vCllVal) _
And Len(vCllVal) >= 7 And Len(vCllVal) <= 8)) Then
Rem Delete Row
.Rows(LRow).EntireRow.Delete
End If: Next: End With
End Sub