'Exit For' is not working - vba

Doing a reverse for loop in Excel VBA, looking for the last populated cell in a certain column. Once found, it should exit the loop, but Exit For is not working, and continues looping all the way back. Any ideas?
rewind:
' so we 're still "under", rollback to the right line
While Not Range("I" & a).Value = getsum
a = a - 1
On Error GoTo TryCatch
If Not Range("E" & a).Value = "" Then
Rows(a).Select
currfield = Range("E" & a).Value
runningstrsum = runningstrsum - currentstrsum 'we're switching streets
' and since we just lost currentstrsum, we have to reset it to the last one, yay
For c = a - 1 To 2 Step -1
If Not Range("E" & c).Value = "" Then 'there it is
currentstrsum = Range("E" & c).Value
Exit For
End If
Next c
End If
Wend
If overunder < 0 Then 'go back to overunder<
GoTo goodjobunder
ElseIf overunder = 0 Then
GoTo goodjobeven
End If

You're only exiting the inner loop, the code will resume outside of this loop - which is still inside the While loop and therefore re-enter the For loop.
If you want to find the last populated cell in a column just use something like:
Dim lastCell As Excel.Range
Set lastCell = Range("E" & Rows.Count).End(xlUp)
No need to loop.
Might also be a good time to look at Debugging VBA Code

Related

I am getting this error message. Run Time error '1004' Method 'Range' of object'_Global' Failed

I am trying to copy text values only from column H and move them to E. I want to automate it so that everytime a text value comes to H from sheet1, it directly goes to E instead of H. Leaving H empty in that cell.
Sheets("102Tk").Select
Dim row As Long
For row = 17 To 1000
' Check if "textvalue" appears in the value anywhere.
If WorksheetFunction.IsText(Range("H" & i)) Then
' Copy the value and then blank the source.
Range("E" & i).value = Range("H" & i).value
Range("H" & i).value = ""
End If
Next
End Sub
Should i be row?
Option Explicit
Sub n()
Sheets("102Tk").Select
Dim row As Long
For row = 17 To 1000
' Check if "save" appears in the value anywhere.
If Not IsNumeric(Range("H" & row)) Then
' Copy the value and then blank the source.
Range("E" & row).Value = Range("H" & row).Value
Range("H" & row).Value = ""
End If
Next
End Sub
Which avoiding using row as a variable name and a few other tidies could be:
Option Explicit
Public Sub SetValues()
Dim currentRow As Long
With ThisWorkbook.Worksheets("102Tk") 'taking note of the comments and using worksheet collection to avoid Chart sheets
For currentRow = 17 To 1000
' Check if "save" appears in the value anywhere.
If Not IsNumeric(.Range("H" & currentRow)) Then
' Copy the value and then blank the source.
.Range("E" & currentRow) = .Range("H" & currentRow)
.Range("H" & currentRow) = vbNullString
End If
Next currentRow
End With
End Sub

VBA - copy rows - if it found error, then continue in copy cells

I have macro which copy cells to below's cells.
Sub CopyRows2()
Dim LastRow As Long
With Worksheets("Ready to upload") ' <-- here should be the Sheet's name
LastRow = .Cells(.Rows.Count, "AD").End(xlUp).Row ' last row in column C
For i = 2 To LastRow
If Range("AD" & i) > "" And Range("AD" & i + 1) = "" Then
Range("AD" & i).Copy
Range("AD" & i + 1).PasteSpecial xlPasteValues
Application.CutCopyMode = False
Else
End If
Next
End With
ActiveWindow.ScrollRow = 1 'scrolling the screen to the top
End Sub
It works fine, until it will found #N/A, then it will give me an error msg: Run-time error '13' - type mismatch. In that case, I would like to skip it and then continue in copy rows.
[
Could you advise me, how to do that, please?
Many thanks!
Option 1
The easiest way is to embed On Error Resume Next in your code. Then it will work.
Option 2
If you want to be one step more professional, then you can use something like this:
Sub CopyRows2()
Dim LastRow As Long
On Error Resume Next
'your code
If Err.Number = 13 Then Err.Clear
On Error GoTo 0
End Sub
It will disregard error 13, but it will tell you if there are other errors, which is quite useful.
Option 3 Check for error like this:
If Not IsError(Range("AD" & i)) And Not IsError(Range("AD" & i + 1)) Then
'embed the code here
End If

Excel 2013 VBA - For Next Loop Suddenly Stopped Working

I'm almost embarrassed to post this, but I am dumbfounded. 6 months ago, I wrote a VERY simple For/Next Loop to cycle through the cells of a column and, if certain criteria was met, perform an action. It has worked flawlessly for the past 6 months. Today, it quit working.
Sub Button1_Click()
Dim x As Integer
Dim DateCell As String
Dim LastRow As Variant
LastRow = Worksheets("Paste Here").Range("A65536").End(xlUp).Row
On Error Resume Next
For x = 2 To LastRow
DateCell = Worksheets("Paste Here").Range("A" & x)
If Right(DateCell, 4) = "2015" Then
Else
Worksheets("Paste Here").Range("A" & x).Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Worksheets("Paste Here").Range("A" & x).Value = Worksheets("Paste Here").Range("A" & x - 1).Value
End If
Next x
On Error GoTo 0
MsgBox ("Done! " & x & " rows analyzed.")
End Sub
When I step through to the "For" line, it sets the value of x to zero. When it gets to the "Next x" line, it increments it to 1, but then doesn't loop...instead it goes to "On Error" and finishes. I even tried setting x = 2 before the loop, but same thing....it will increment to 3 and then exit the loop.
What could have changed? I even went back to my original file and tried running it, same thing.
Matthew was on the right track. Because of this line:
LastRow = Worksheets("Paste Here").Range("A65536").End(xlUp).Row
If you have something in a cell in column A above A65536 and below cell A32768 then VBA will just set x to 0 and the loop will not execute.

1004: Application defined error when trying to examine cell contents

I am trying to loop through the rows in my sheet, adding cells B-F of the current row to a range to be copied to another sheet. The cells in the row (B-F) should only be added to the range if the value in column G is "Active" and if the value in column C has a value (not empty/nothing/null/!#VALUE...)
I've tried several ways around it, but I keep getting 1004: App/Object defined error off the first If statement
The msgbox shows me the range is valid, I've tried qualifying to the tiniest detail and also using Cells() instead of .range to no avail.
MsgBox (ActiveWorkbook.Worksheets("Staging").range("G" & Cells(rows.Count, 5).End(xlUp).Row).Value)
For i = Cells(rows.Count, 5).End(xlUp).Row To i = 1 Step -1
If ActiveWorkbook.Worksheets("Staging").Cells("G" & i).Value = "Active" Then
If Not IsError(ActiveWorkbook.Worksheets("Staging").range("C" & i)) Then
Set selectRange = range("B" & i & ":F" & i)
Set copyRange = Union2(copyRange, selectRange)
Else
'Do Nothing
End If
Else
'Do Nothing
End If
Next
Am I just missing something simple here? I've been banging my head over this for hours now.
...and for you eagle eyes out there, Union2 isn't a typo, just a user defined function to avoid not being able to join ranges set to "Nothing"
Try the following:
Change the second line to
For i = Cells(rows.Count, 5).End(xlUp).Row To 1 Step -1
Change the third line to
If ActiveWorkbook.Worksheets("Staging").Range("G" & i).Value = "Active" Then
To start change:
If ActiveWorkbook.Worksheets("Staging").Cells("G" & i).Value = "Active" Then
To
If ActiveWorkbook.Worksheets("Staging").Range("G" & i).Value = "Active" Then
Or
If ActiveWorkbook.Worksheets("Staging").Cells(i , 7).Value = "Active" Then
You also need to fully qualify all your ranges as alot of your ranges are pointing to the active sheet and NOT "staging" Unless it is the active sheet, but just to be sure you should use the following code:
With ActiveWorkbook.Worksheets("Staging")
MsgBox (.Range("G" & .Cells(.Rows.Count, 5).End(xlUp).Row).Value)
For i = .Cells(.Rows.Count, 5).End(xlUp).Row To 1 Step -1
If .Range("G" & i).Value = "Active" Then
If Not IsError(.Range("C" & i)) Then
Set SelectRange = .Range("B" & i & ":F" & i)
Set copyRange = Union(copyRange, SelectRange)
Else
'Do Nothing
End If
Else
'Do Nothing
End If
Next
End With
Also You are using copyRange in this scope without it being declared, I am assuming you are assigning it to a range earlier in your code but if not please make sure to do that.
This is wrong:
ActiveWorkbook.Worksheets("Staging").Cells("G" & i).Value
You can use these:
ActiveWorkbook.Worksheets("Staging").Cells(i, 6)
ActiveWorkbook.Worksheets("Staging").range(cells(i, 6), cells(i, 6)).value
ActiveWorkbook.Worksheets("Staging").range("G" + strings.trim(str(i))).value
I was getting the below Error:
Go to Home -> Select the cell for which you are getting Error-> Use clear all funtion to clear the method.
I executed the script again and it started working fine.

Stuck with a loop. After it fulfilled its function it keeps on going

The first code is there to see if the number 20 is already in the spaces B28 till B47. If that is the case, I want it to move on to the next step. If the number 20 is not there, then i would like it to add the number to line B47 and then end after completing that. I'm haing problems trying to get it to stop after it added the number 20. Instead of ending, it continues down the column and adds een more 20s due to it not finidng any. What I have been trying to create is a loop which checks all the cells first, and if it does not find 20 it adds it once, instead of adding it 20 times.
The second code I hae after this is there to try to delete all empty rows in B28 till B47. However, it does not do that and skips this loop entirely moving to Blargh3 instead. I have tried creating loops for this, but Excel has always been giving me an error with it. I have tried researching as to how I could fix it after i have tried myself. I was not able to find anything which helped me.
As I am quite new to VBA, help would be greatly appreciated.
For Each Cell In Worksheets("Sheet1").Range("B28:B48")
If Cell.Value > 19 Then
GoTo Blargh2
Else:
Range("B" & 47, "BM" & 47).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("B" & 47) = 20
Dim a As Long
For a = 3 To 65
Cells(47, a) = 3
Next
End If
Next
Blargh2:
For Each Cell In Worksheets("Sheet1").Range("B28:B47")
If Cell.Value = 0 Then
Row.Delete X1DeleteShiftUp
Else:
GoTo Blargh3
End If
Next
Blargh3:
Dim i As Long
For i = 47 To 29 Step -1
If Range("B" & i) - Range("B" & i).Offset(-1, 0) > 1 Then
Range("B" & i, "BM" & i).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("B" & i) = Range("B" & i).Offset(1, 0) - 1
Dim c As Long
For c = 3 To 65
Cells(i, c) = 3
Next
i = i + 1
End If
Next
Turn on your Immediate Window -> ctrl+g or in the menu bar click View => Immediate Window
This would be the first part based on your logic
Sub FirstPart()
Dim is20There As Range
With Range("B28:B47")
Set is20There = .Find(What:="20", LookIn:=xlValues, lookat:=xlPart)
End With
If is20There Is Nothing Then
Debug.Print "20 is not there, executing your code now"
Range("B" & 47, "BM" & 47).Insert shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("B" & 47) = 20
Dim a As Long
For a = 3 To 65
Cells(47, a) = 3
Next
Else
Debug.Print "exiting because 20 is there"
End If
End Sub
What happens here in the first loop is
using the .Find function in range B28:B47 to find the value of 20. If the value is there then the Else part of the loop will execute which simply does nothing but prints a message to the Immediate Window that 20 has been found.
this is when the 20 is not there
If 20 is not found (If is20There is Nothing evaluates to True) then you can execute your code which I guess adds a row at B47 (shifting the last row down ) and fills the cells with number 3 all the way down to 65th column except the B column which you seem to assign number 20 to.
So if 20 is not there the code literally does nothing.
this is when 20 is there (nothing happens)
The second part loops through B28:B47 backwards ( starting form the end to beginning ) and deletes the entire rows if any of them are empty ( column B only )
this is before
then run the code
Sub SecondPart()
Dim i As Long
Dim cell As Range
For i = 47 To 28 Step -1
Set cell = Range("B" & i)
If IsEmpty(cell) Then
Rows(cell.Row & ":" & cell.Row).Delete shift:=xlUp
End If
Next i
End Sub
and this is after