I want to loop through a column B and delete all the rows with Empty cells in column B but it seems to be getting stuck at the End If part (No error message)
Dim lastrow As Long
With ActiveSheet
lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
Dim i As Integer
i = 2
Do While i <= lastrow
If Range("B" & i) = "" Then
ws.Rows(i).Delete
Else
i = i + 1
End If
Loop
End Sub
Since you know how many iterations you'll need before you begin looping, use a For loop.
When you encounter a row you want to delete, Union it with the other rows you want to delete.
Once you've marked all rows you want to remove, delete them in one single operation.
Dim marked As Range
Dim i As Long
For i = 1 To lastRow
If ActiveSheet.Range("B" & i).Value = "" Then
If marked Is Nothing Then
Set marked = ActiveSheet.Range("B" & i)
Else
Set marked = Union(marked, ActiveSheet.Range("B" & i))
End If
End If
Next
If Not marked Is Nothing Then marked.EntireRow.Delete
This should perform noticeably faster than iterating the rows in reverse and deleting them one by one.
Note:
i is declared As Long, because Integer will overflow beyond 32,767; a worksheet can have many more rows than that.
Range calls are all explicitly qualified with ActiveSheet. Unqualified Range calls implicitly refer to ActiveSheet... unless you're in a worksheet's code-behind, in which case they refer to that worksheet. Better to have code that does what it says, and says what it does.
Not clear what ws meant to be, since it's nowhere in your code and everything is working off ActiveSheet anyway (implicitly or explicitly).
Related
I have data that I am working to Parse Out that I have imported from approval emails sent in Outlook. At this point I am just importing the CreationTime and the SubjectLine.
For the subject line I am able to use the Split function to separate out most of the data. I then am left with Job Codes in Column B and Position numbers in Column C which includes the text: "Job Codes: XXXX" and the four digit job code number and "PN XXXX" and either a four digit or 6 digit position number. I am trying to use the Right functionality to loop through the entire column and reformat the column just to show only the four digit job code number for Column B and either just the 4 digit or 6 digit position number (the actual numbers) for Column C
For Job Code Column B:
Currently my code works for Shortening the Job Codes but it involves adding a column, putting the RIGHT formula in that column for the shortened Job Code, then copying and pasting the formula as values back into the column and then deleting the original column.
The problem- Works but perhaps not the most efficient with a larger data set (currently 200 rows but will have 2000 or more)
Code:
Sub ShortenJobCodes()
Application.ScreenUpdating = False
Const R4Col = "=RIGHT(RC3,4)"
Dim oRng As Range
Dim LastRow As Long
Range("B1").EntireColumn.Insert
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
Set oRng = Range("B:B")
Range(oRng, Cells(LastRow, "B")).FormulaR1C1 = R4Col
Set oRng = Nothing
Columns("B").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues
Range("C1").EntireColumn.Delete
Application.ScreenUpdating = True
End Sub
For Position Numbers Column C:
Currently I have mirrored the above code but added in an if statement using LEN to count if the characters are less than 8, if so then insert one RIGHT function if not insert the other RIGHT function. This also involves adding an additional column putting the RIGHT formula in that column for the shortened Position Number(Eliminating all but just the number), then copying and pasting the formula as values back into the column and then deleting the original column.
Problem - This works but seems to take forever to process and in fact looks like it is in an infinite loop. When I Esc out of it, it does add the column and then input the proper RIGHT formula (leaving just the numeric values) but the sub never seems to end, nor does it copy and paste the formulas as values or delete the original column. As noted above I realize this is likely a more efficient way to do this but I have tried a bunch of options without any luck.
I am realizing part of the loop might be due to the range itself being an entire column but I cannot find a way to stop that with the last row (even though I have a count in there).
Code:
Sub ShortenPositionNumbers()
Application.ScreenUpdating = False
Const R4Col = "=RIGHT(RC4,4)"
Const R6Col = "=RIGHT(RC4,6)"
Dim oRng As Range
Dim rVal As String
Dim y As Integer
Dim selCol As Range
Dim LastRow As Long
Range("C1").EntireColumn.Insert
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
Set selCol = Range("D:D")
For Each oRng In selCol
oRng.Select
rVal = oRng.Value
If Len(oRng.Value) > 8 Then
oRng.Offset(0, -1).FormulaR1C1 = R6Col
Else
oRng.Offset(0, -1).FormulaR1C1 = R4Col
End If
Next
Set oRng = Nothing
Columns("C").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues
Range("D1").EntireColumn.Delete
Application.ScreenUpdating = True
End Sub
Major Question: Is there a way to use RIGHT/TRIM/LEN/LEFT functions to do this within a cell without having to add columns/delete columns and insert functions?
There are a few things you can do here to speed up your code. I'm only going to reference the second code block as you can apply similar logic to the first.
The first issue is that you create a LastRow variable but never reference it again. It looks like you meant to use this in the selCol range. You should change that line to Set selCol = Range("C1:C" & lastRow). This way, when you loop through the rows you only loop through the used rows.
Next, in the For-Each loop you Select every cell you loop through. There really isn't any reason to do this and takes substantially longer. You then create the variable rVal but never use it again. A better way to set up the loop is as follows.
For Each oRng in selCol
rVal = oRng.Value
If Len(rVal) > 8 Then
oRng.Value = Right(rVal, 6)
Else
oRng.Value = Right(rVal, 4)
End If
Next
This is much cleaner and no longer requires creating columns or copying and pasting.
Try this, it uses Evaluate and no loops or added columns.
Sub ShortenPositionNumbers()
Application.ScreenUpdating = False
Dim selCol As Range
Dim LastRow As Long
With ActiveSheet
LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
Set selCol = .Range(.Cells(1, 3), .Cells(LastRow, 3))
selCol.Value = .Evaluate("INDEX(IF(LEN(" & selCol.Address(0, 0) & ")>8,RIGHT(" & selCol.Address(0, 0) & ",6),RIGHT(" & selCol.Address(0, 0) & ",4)),)")
End With
Application.ScreenUpdating = True
End Sub
Or work with arrays
Sub ShortenPositionNumbers()
Dim data As Variant
Dim i As Long
With Range("C3:C" & Cells(Rows.Count, "A").End(xlUp).Row)
data = Application.Transpose(.Value)
For i = LBound(data) to UBound(data)
If Len(data(i)) > 8 Then
data(i) = RIGHT(data(i),6)
Else
data(i) = RIGHT(data(i),4)
End If
Next
.Value = Application.Transpose(data)
End With
End Sub
I am trying to delete specific rows from an excel sheet, if the data contained in a specific cell are different from their neighbors
The sheet is already sorted, as a result I can have this comparison.
The issue here is that, although a sheet around 3,000 lines would take less than a minute, when this escalates to 60,000 the function seems to never end.
Is there something wrong in what I am trying?
Is there a more efficient way?
Private Function DeleteSingleItemLines() As Long
Dim lastRow As Long
With ActiveSheet
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
lastRow = lastRow - 2
For rwIndex = 6 To lastRow
If Cells(rwIndex, "B").Value <> Cells(rwIndex + 1, "B").Value _
And Cells(rwIndex, "B").Value <> Cells(rwIndex - 1, "B").Value Then
Rows(rwIndex & ":" & rwIndex).Delete Shift:=xlUp
lastRow = lastRow - 1
rwIndex = rwIndex - 1
End If
Next rwIndex
DeleteSingleItemLines = lastRow
End Function
Well, first of all, with very small changes in your code you can make it faster by setting the property ScreenUpdating to false (write this code right after declaring variables) as in:
Application.ScreenUpdating = False
The code above keeps Excel without rendering changes in the screen and makes processing a lot faster.
Thinking about your problem in another way, you could put a formula inside your worksheet returning TRUE or FALSE for the condition you have and then use a AutoFilter to delete them all at once. It is possible to do that in vba code also.
Best regards,
Abe
I have this sub in Excel 2010 which is supposed to filter through all the cells in a sheet until it finds a match to Proj No, then paste a field from this row into another field.
When I try to run the sub, it gives me an error 1004: Select Method of Worksheet Class Failed. I've marked the line where this occurs. Any assistance would be greatly appreciated.
Option Explicit
Private Sub btnNext_Click()
Dim ProjNo As String
Dim Col As String
Dim Row As String
Dim cell As Range
Unload Dialog
formWait.Show
Sheets("Sheet7").Activate
ProjNo = Worksheets("Sheet1").Range("D6").Value
Col = Cells(Rows.Count, "A").End(xlUp).Row
For Each cell In Range("A2:A" & Col)
If cell.Value = ProjNo Then
Row = Row & cell.Row
End If
Next cell
Workbooks("Form.xlsm").Sheets("Sheet7").Range("Row, 6").Copy Destination:=Sheets("Sheet1").Range("19, 5") ‘Error
Unload formWait
End Sub
I don't know what GWP is, but I think you want to use ProjNo there. The Range property doesn't accept an argument like that. Unless you have a named range of "Row,6" which you don't because it's not a legal name, you have to supply Range with a valid range reference, like A6 or D2:D12, for example.
Also, you can't concatenate rows and use them in a Range reference to get a larger range. You would have to copy each row inside the loop, union the ranges as you go, or better yet, filter on the value that you want and copy the visible rows.
Try this:
Private Sub btnNext_Click()
With ThisWorkbook.Worksheets("Sheet7")
'filter for the project id
.Range("A1", .Cells(.Rows.Count, 1).End(xlUp)).Resize(, 6).AutoFilter 1, "=" & .Range("D6").Value
'copy the visible rows
.Range("F2", .Cells(.Rows.Count, 6).End(xlUp)).SpecialCells(xlCellTypeVisible).Copy _
ThisWorkbook.Worksheets("Sheet1").Cells(19, 5)
'get rid of the filter
.AutoFilterMode = False
End With
End Sub
There are a few confusing items in your code above, so I wanted to place them long-form here. Let's get started:
Dim Col As String
Dim Row As String
It looks like your design expects these to be of type Long rather than type String. Even if these variables were meant to be strings, I would recommend adjusting their names -- when your fellow developer attempts to review your design, he or she is likely to see names like "Col" or "Row" and think "these are numbers". Easy fix:
Dim Col As Long, Row As Long
The next issue comes up here:
Col = Cells(Rows.Count, "A").End(xlUp).Row
The structure above is a common method for identifying the last ROW, not column. (It also appears that you have switched the "A" and number, which is another easy fix). While it is perfectly acceptable syntactically to name the variable for last row "Col", human users are likely to find this confusing. Identifying the last row (and the last col, which you use in the For Each loop), as explained in fantastic detail here, would be better handled like this:
Dim SheetSeven As Worksheet, SheetOne As Worksheet
Dim LastRow As Long, LastCol As Long
Set SheetSeven = ThisWorkbook.Worksheets("Sheet7")
Set SheetOne = ThisWorkbook.Worksheets("Sheet1")
With SheetSeven
LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
LastCol = .Range("A" & .Columns.Count).End(xlToLeft).Column
End With
This should make your For Each loop look like this:
With SheetSeven
For Each cell in .Range("A2:A" & LastCol)
'... do you comparison and row incrementing here
Next cell
End With
Once you've identified your sheet as a variable, the Range.Copy action should be much easier as well:
With SheetSeven
.Range(.Cells(Row, 6)).Copy _
Destination:=SheetOne.Range(SheetOne.Cells(19, 5))
End With
Also one other thing you may wish to check is the status of Application.ScreenUpdating.
With the release of Office 2013 and later, a SDI (Single Document Interface) was introduced. If Application.ScreenUpdating is False and the workbook is not active, the implied call to Workbook.Activate will fail. Check the status of ScreenUpdating and set it to True if needed. You can set it back to False after the first Activate call for that workbook is made.
See this article:
https://support.microsoft.com/en-us/help/3083825/excel-workbook-is-not-activated-when-you-run-a-macro-that-calls-the-wo
In my case the error came as the sheet was hidden.
so I check if I am not working with the hidden sheet. Or you need to unhide the sheet before you try to select or activate sheet.
For Each sh In ThisWorkbook.Sheets
If Left(sh.Name, 8) <> "Template" Then
sh.Select
sh.Range("A1").Select
End If
Next
I am hiding the rows by using following lines of code excluding top two rows only because they are Headers.
For i=3 To ThisWorkBook.Sheets("ALL").Range("A1",ThisWorkBook.Sheets("ALL").Range("A65536").End(xlUp)).Rows.Count
ThisWorkBook.Sheets("ALL").Rows(i).EntireRow.Hidden=True
Next
Now to get the hidden rows count i am using following lines of code
From i=3 To ThisWorkBook.Sheets("ALL").Range("A1",ThisWorkBook.Sheets("ALL").Range("A65536").End(xlUp)).Rows.Count
ThisWorkbook.Sheets("ALL").EntireRow.Hidden=False
Next
But I am getting rowcount as 2. Infact the sheet has 10 rows. So how to make hidden rows as visible?
If I understand your question correctly, here is an alternative way to approach your problem that will give you some code that runs faster and is a pretty clean to manage:
Option Explicit
Sub CountHiddenRows()
Dim wks As Worksheet
Set wks = ThisWorkbook.Sheets("ALL")
With wks
Dim lngLastRow As Long
lngLastRow = .Range("A" & .Rows.Count).End(xlUp).Row
.Range("A3:A" * lngLastRow).EntireRow.Hidden = True
Dim rngConsider As Range
Dim lngHiddenRows As Long, lngRows As Long, lngVisibleRows As Long
Set rngConsider = .Range("A1:A" & lngLastRow)
lngRows = rngConsider.Rows.Count
lngVisibleRows = rngConsider.SpecialCells(xlCellTypeVisible).Rows.Count
lngHiddenRows = lngRows - lngVisibleRows
MsgBox "There are " & lngHiddenRows & " hidden rows."
End With
End Sub
Worksheet.Rows.Count always returns the total number of rows in a sheet.
Here I would use Worksheet.UsedRange.Rows.Count.
Also, your code risks to fail when the first cell of the last row is empty.
Here is a little function that counts the number of visible rows between row 2 and the last used row.
Function CountVisibleRows() As Integer
Dim R As Integer
For R = 2 To UsedRange.Rows.Count
If Not Rows(R).Hidden Then CountVisibleRows = CountVisibleRows + 1
Next R
End Function
I usually use a cycle when the number of rows is small, because I have better control and it's often faster.
When I work with thousands of rows then it's faster asking Excel to use the SpecialCells or other functions.
I'm trying to run a macro that will delete rows that don't contain a particular value in column B. Here's my code:
Sub deleteRows()
Dim count As Integer
count = Application.WorksheetFunction.CountA(Range("AF:AF"))
Dim i As Integer
i = 21
Do While i <= count
If (Application.WorksheetFunction.IsNumber(Application.WorksheetFunction.Search("OSR Platform", Range("B" & i))) = False) Then
If (Application.WorksheetFunction.IsNumber(Application.WorksheetFunction.Search("IAM", Range("B" & i))) = False) Then
Rows(i).EntireRow.Delete
i = i - 1
count = count - 1
End If
End If
i = i + 1
Loop
End Sub
Now what it SHOULD be doing is the following:
1.) Find the number of rows to go through and set that as count (this works)
2.) Start at row 21 and look for "OSR Platform" and "IAM" in column B [this kind of works (see below)]
3.) If it finds neither, delete the entire row and adjust the count and row number as necessary (this works)
For some reason, whenever the code gets to the first If statement, an error window with a red X pops up that just says "400." As far as I can tell, I have written everything syntactically soundly, but clearly there's something wrong.
You may want to start by looping the other way. When you delete a line, all the previous lines are shifted. You account for this, but a reverse loop is simpler (for me anyways) to understand than keeping track of when I've offset the current position within the loop:
For i = count To 21 Step -1
Also, you're relying too much on Application.WorksheetFunction:
(Application.WorksheetFunction.IsNumber(Application.WorksheetFunction.Search("OSR Platform", Range("B" & i))) = False)
to
InStr(Range("B" & i).value, "OSR Platform") > 0
Application.WorksheetFunction takes much more processing power, and depending on what you are trying to accomplish, this can take a significantly longer amount of time. Also for this suggested change, the code size is reduced and becomes easier to read without it.
Your count can also be obtained without A.WF:
Excel 2000/03: count = Range("AF65536").End(xlUp).Row
Excel 2007/10: count = Range("AF1048576").End(xlUp).Row
Version independent: count = Range("AF" & Rows.Count).End(xlUp).Row
One more thing is that you can do (and should do in this case) is combine your If statements into one.
Making these changes, you end up with:
Sub deleteRows()
Dim count As Integer
count = Range("AF" & Rows.Count).End(xlUp).Row
Dim i As Integer
For i = count To 21 Step -1
If Len(Range("B" & i).value) > 0 Then
If InStr(Range("B" & i).value, "OSR Platform") > 0 Or InStr(Range("B" & i).value, "IAM") > 0 Then
Range("B" & i).Interior.Color = RGB(255, 0, 0)
End If
End If
Next i
End Sub
If this does not help, then can you step through the code line by line. Add a breakpoint, and step through with F8. Highlight the variables in your code, right-click, choose "add Watch...", click "OK", (Here's an excellent resource to help you with your debugging in general) and note the following:
Which line hits the error?
What is the value of i and count when that happens? (add a watch on these variables to help)
This worked for me. It uses AutoFilter, does not require looping or worksheet functions.
Sub DeleteRows()
Dim currentSheet As Excel.Worksheet
Dim rngfilter As Excel.Range
Dim lastrow As Long, lastcolumn As Long
Set currentSheet = ActiveSheet
' get range
lastrow = currentSheet.Cells(Excel.Rows.Count, "AF").End(xlUp).Row
lastcolumn = currentSheet.Cells(1, Excel.Columns.Count).End(xlToLeft).Column
Set rngfilter = currentSheet.Range("A1", currentSheet.Cells(lastrow, lastcolumn))
' filter by column B criteria
rngfilter.AutoFilter Field:=2, Criteria1:="<>*OSR Platform*", Operator:= _
xlAnd, Criteria2:="<>*IAM*"
' delete any visible row greater than row 21 which does not meet above criteria
rngfilter.Offset(21).SpecialCells(xlCellTypeVisible).EntireRow.Delete
' remove autofilter arrows
currentSheet.AutoFilterMode = False
End Sub
This code applies AutoFilter to column B to see which rows contain neither "OSR Platform" nor "IAM" in column B. Then it simply deletes the remaining rows greater than 21. Test it on a copy of your workbook first.
With a huge nod to this OzGrid thread, because I can never remember the proper syntax for selecting visible cells after filtering.