Code not looping through sheets - vba

The following code is deleting too much on first sheet and then not looping to second sheet?? Error appearing on .FindNext statement.
Sub FindAndExecute3()
Dim Loc As Range
Dim sh As Worksheet
For Each sh In ThisWorkbook.Worksheets
With sh.UsedRange
Set Loc = .Cells.Find(What:="AUTO.WHSE.")
If Not Loc Is Nothing Then
Do Until Loc Is Nothing
Rows(ActiveCell.Row & ":" & (ActiveCell.Row + 2)).Delete
Set Loc = .FindNext(Loc)
Loop
End If
End With
Set Loc = Nothing
Next
End Sub

You have to fully qualify your Ranges.
This issue shows up once and again (e.g., this).
What does this mean? Do not use Cells, Range, Rows or Columns without specifying which Worksheet they belong to, unless you specifically want to do that (and even in that case, explicitly using ActiveSheet improves readability and reduces the chances of errors, similar to using Option Explicit).
For instance, replace
Rows(ActiveCell.Row & ":" & (ActiveCell.Row + 2)).Delete
with
sh.Rows(sh.<something>.Row & ":" & (sh.<something>.Row + 2)).Delete
I am assuming the Range to be deleted spans Row numbers taken from something related to sh.
Note 1: In this case, even without qualifying Ranges, code continues execution and the mistake may go unnoticed, as it produces a valid result. In other cases, code without fully qualified Ranges will throw an error (e.g., with something like sheet1.Range(Cells(..., when sheet1 is not the ActiveSheet).**
Note 2: You can work with the ActiveCell only when the Worksheet that it is on is the ActiveSheet [MSDN].

Related

VBA: Considering only the value of the last cell in A and extend selection untill W

I have several columns from A to W. some aer full and some empty and some with "0", but i need to get the last value in A and selecting from A17 untill W (LastValueOfA)
For example A is starting from rows 17, B arrive untill 30 and W is full of 0 till the end of the sheet. I want a selection from A17 till W that stops where there is the last value of A and then copy or cut the values and append them on another sheet of the same file called "order inputs".
At the moment i only found the way to found and select the lastrow with values inside, but it consider all the columns obviously, not only A:
Dim wb As Workbook
LASTROW = Sheet1.Range("A" & Rows.Count).End(xlUp).Row
Range("a17:W" & LASTROW).Select
Thanks in advance.
Since your last comments on #K.Davis answer, I guess your column A values are resulting out of a formula the value of which you consider to be valid when starting with "US"
So you may try this:
With ThisWorkbook.Worksheets("Sheet1") ' change "Sheet1" to your actual sheet name
.Range("A17:W" & .Columns("A").Find("US*", SearchDirection:=xlPrevious, LookIn:=xlValues).Row).Select
End With
I believe the issue is related to formulas that output an empty string. While the cell may appear to be blank, it's technically not. You need to search in the cell's Values.
You can use Find() to get around this.
Try this:
Option Explicit
Sub Test()
Dim ws As Worksheet, lastRow As Long
Set ws = ThisWorkbook.Worksheets("Sheet1")
lastRow = ws.Columns("A").Find("*", SearchDirection:=xlPrevious, LookIn:=xlValues).Row
MsgBox lastRow
End Sub
"*" returns any value - it's just a wild card.
xlPrevious will search from the bottom-up
and finally, xlValues ensures you are looking at the Cell's output - not at the cell.

Create Range excluding column in middle

I have the problem of needing to exclude a column in the middle of my excel worksheet. Is there a way of creating a range that excludes a column not on the edges of the data. The range is dynamic ranging from A1:AA#. The column "F" needs to be excluded from this range. This range needs to be stored for use in a pivotTable.
Range("A1:E4,G1:J4").Select
This is how the excel macro recorder creates a range with a gap, but I cannot find a way to modify this so the last cell is dynamic.
Thanks.
Just as you should avoid using the .Select Method, you should also avoid using the .UsedRange when possible (See here).
You can try something like this. It is not as clean, but may prove to be less bug prone.
Dim LRow As Long
LRow = Range("A" & Rows.Count).End(xlUp).Row
Dim MyRange1 As Range, MyRange2 As Range, BigRange As Range
Set MyRange1 = Range("A1:E" & LRow)
Set MyRange2 = Range("G1:J" & LRow)
Set BigRange = Application.Union(MyRange1, MyRange2)
BigRange.Select
You can then refer to your BigRange directly moving forward.
If you have only one set of data in your sheet, you could try something like that :
Intersect(ActiveSheet.UsedRange, Range("A:E,G:AA")).Select
This will select everything that contains data up to column AA on the sheet except for column F.
Whenever possible , you should avoid using .select .activate but you only provide one line of your code so I can't help you much on that part except redirect you to this.
you could use
Dim rng As Range
Set rng = Intersect(Range("A:E,G:AA"), Rows(1).Resize(Cells(Rows.Count, 1).End(xlUp).Row))
where the column index in Cells(Rows.Count, 1) lets you choose what column size your range after

Trouble copying rows to next empty row in different worksheet

I'm having trouble with an assignment.
I'm having this sheet with 18287 students. One in each row. They have individual person ID's, they have different campus', they've been enrolled for their education at different times etc. etc.
I'm building a loop-code, that finds the students that are delayed and have been rolled back. If they are delayed, the H column has to be below 133. Equally i'm looking for students currently studying a bachelor degree. Which means that column L must be "Bachelor". My loop looks like this at the time:
for i = 2 to 18288
If worksheets(1).range(i,5)<133 and worksheets(1).range(i,11)="Bachelor" then
worksheets(1).row(i).copy
I'm trying to copy the row to the first empty row in worksheet (Delayed Students). I've tried many different approaches. Some of them don't copy anything, other attempts has resulted in excel shutting down... I've searched Google, and what I've concluded is that the .select, .copy, .paste procedures are very demanding, and could cause a crash.
So i'm looking for a code, where I don't necessarily have to copy the rows. Any help with that, I'm running out of possible solutions myself..?
Did you ever think about filtering column H < 133 and L for "Bachelor"? I think filters are much easier and should even be faster.
With Worksheets(1).UsedRange
.AutoFilter Field:=8, Criteria1:="<133", Operator:=xlAnd
.AutoFilter Field:=12, Criteria1:="=Bachelor", Operator:=xlAnd
.SpecialCells(xlCellTypeVisible).Copy
End With
Worksheets("SheetToPasteIn").Range("A1").PasteSpecial
The most consuming time for the code is to access the Worksheet, like the Copy command. You can minimize by using a CopyRng object to merge all the Rows that pass your criteria, using the Union function.
At the end you just Copy the entire range at once.
Note: column "H" using the Range in your loop should be Range("H" & i), and not range(i,5). The same for the other case.
Try the modified code below:
Dim i As Long
Dim CopyRng As Range
With Worksheets(1)
For i = 2 To 18288
If .Range("H" & i).Value < 133 And .Range("K" & i).Value2 = "Bachelor" Then
If Not CopyRng Is Nothing Then
Set CopyRng = Application.Union(CopyRng, .Rows(i))
Else
Set CopyRng = .Rows(i)
End If
End If
Next i
End With
' check at least 1 rows in the Range
If Not CopyRng Is Nothing Then CopyRng.Copy

MS Excel VBA - Loop Through Rows and Columns (Skip if Null)

Hello stackoverflow community,
I must confess I primarily code within MS Access and have very limited experience of MS Excel VBA.
My current objective is this, I have an expense report being sent to me with deductions in another countries currency, this report has many columns with different account names that may be populated or may be null.
I currently have a Macro that will open an input box and ask for the HostCurrency/USD Exchange rate, my next step will be to start at on the first record (Row 14; Column A-K contains personal info regarding the deduction) then skip to the first deduction account (deduction accounts start at column L and span to column DG) checking if each cell is null, if it is then keep moving right, if it contains a value then I want to multiply that value by my FX rate variable that was entered in the input box, and update the cell with the converion. Once the last column (DG) has been executed I want to move to the next row (row 15) and start the process again all the way until the "LastRow" in my "Used Range".
I greatly appreciate any feedback, explanations, or links that may point me towards my goal. Thank you in advance for taking the time to read though this!
First off, you really should attempt to write the code yourself and post what you have so someone can try to point you in the right direction. If your range is going to be static this is a very easy problem. You can try something along the lines of:
Sub calcRate(rate As Double, lastrow As Integer)
Dim rng As Range
Set rng = Range("L14" & ":DG" & lastrow)
Dim c As Variant
For Each c In rng
If c.Value <> "" Then
c.Value = c.Value * rate
End If
Next
End Sub
This code will step through each cell in the given range and apply the code without the need for multiple loops. Now you can call the calcRate sub from your form where you input the rate and lastrow .
This will do it without looping.
Sub fooooo()
Dim rng As Range
Dim mlt As Double
Dim lstRow As Long
mlt = InputBox("Rate")
With ActiveSheet
lstRow = .Cells(.Rows.Count, 1).End(xlUp).Row
Set rng = .Range(.Cells(14, 12), Cells(lstRow, 111))
rng.Value = .Evaluate("IF(" & rng.Address & " <>""""," & rng.Address & "*" & mlt & ","""")")
End With
End Sub
If your sheet is static you can replace ActiveSheet with WorkSheets("YourSheetName"). Change "YourSheetName" to the name of the sheet.

Delete Hidden/Invisible Rows after Autofilter Excel VBA

I guess this is pretty straight forward, but for some reason it just does not seem to work for me :(
I have the below code which auto-filters the data based on the criteria that I have specified:
Dim lastrow As Long
lastrow = Sheet2.Cells(Sheet2.Rows.Count, "A").End(xlUp).Row
With Sheet2
.AutoFilterMode = False
With .Range("A1:AF" & lastrow)
.AutoFilter
.AutoFilter Field:=7, Criteria1:="Yes", Operator:=xlFilterValues
End With
What I am now looking to do is delete all the Unfiltered (Hidden) rows that do not fit the criteria.
I tried so far:
Sub RemoveHiddenRows
Dim oRow As Object
For Each oRow In Sheets("Sheet2").Rows
If oRow.Hidden Then oRow.Delete
Next
End Sub
But the problem with this code is that it would only remove every other row of consecutive hidden rows because the each increments the row considered even when a row has been deleted and all lower rows have moved up one.
Also I would prefer something without a loop if it's possible, kind of like the opposite of .SpecialCells(xlCellTypeVisible).EntireRow.Delete
All help will be highly appreciated.
So I was kind of looking to get rid of Unfiltered Data rather than trying to reverse all the criteria and delete the visible cells
I would use this one:
Sub RemoveHiddenRows()
Dim oRow As Range, rng As Range
Dim myRows As Range
With Sheets("Sheet3")
Set myRows = Intersect(.Range("A:A").EntireRow, .UsedRange)
If myRows Is Nothing Then Exit Sub
End With
For Each oRow In myRows.Columns(1).Cells
If oRow.EntireRow.Hidden Then
If rng Is Nothing Then
Set rng = oRow
Else
Set rng = Union(rng, oRow)
End If
End If
Next
If Not rng Is Nothing Then rng.EntireRow.Delete
End Sub
I used Dmitry Pavliv's solution for my filtered table and it worked (thanks!) but would intermittently give error: "delete method of range class failed" error.
Error seemed to occur when only one hidden row was to be deleted. It may or may not be of significance that the lone hidden row was right under the table header.
Stepping through the code, rng pointed to correct cell, and showed just the single cell. It was probably an issue with using a Table instead of named range, though other hidden rows deleted fine in same table format.
Macro has been working fine after I modified the last portion of the code
from this:
If Not rng Is Nothing Then rng.EntireRow.Delete
To this:
If rng.Rows.Count = 1 Then
ws.Rows(rng.Row & ":" & rng.Row).Delete
ElseIf rng Is Nothing Then
rng.EntireRow.Delete
End If
For some reason, deleting that single row in this format works. I'm not quite sure why. The rng object is pointing to the correct cell and I'm using it to get the row number, so not sure why it's not working in rng.entirerow.delete statement. Oh well. Sharing as came across many posts with same error unresolved.