Continue For loop - vba

I have the following code
For x = LBound(arr) To UBound(arr)
sname = arr(x)
If instr(sname, "Configuration item") Then
'**(here i want to go to next x in loop and not complete the code below)**
'// other code to copy past and do various stuff
Next x
So I thought I could simply have the statement Then Next x, but this gives a "no for statement declared" error.
So what can I put after the If instr(sname, "Configuration item") Then to make it proceed to the next value for x?

You can use a GoTo:
Do
'... do stuff your loop will be doing
' skip to the end of the loop if necessary:
If <condition-to-go-to-next-iteration> Then GoTo ContinueLoop
'... do other stuff if the condition is not met
ContinueLoop:
Loop

You're thinking of a continue statement like Java's or Python's, but VBA has no such native statement, and you can't use VBA's Next like that.
You could achieve something like what you're trying to do using a GoTo statement instead, but really, GoTo should be reserved for cases where the alternatives are contrived and impractical.
In your case with a single "continue" condition, there's a really simple, clean, and readable alternative:
If Not InStr(sname, "Configuration item") Then
'// other code to copy paste and do various stuff
End If

For i=1 To 10
Do
'Do everything in here and
If I_Dont_Want_Finish_This_Loop Then
Exit Do
End If
'Of course, if I do want to finish it,
'I put more stuff here, and then...
Loop While False 'quit after one loop
Next i

A lot of years after... I like this one:
For x = LBound(arr) To UBound(arr): Do
sname = arr(x)
If instr(sname, "Configuration item") Then Exit Do
'// other code to copy past and do various stuff
Loop While False: Next x

A few years late, but here is another alternative.
For x = LBound(arr) To UBound(arr)
sname = arr(x)
If InStr(sname, "Configuration item") Then
'Do nothing here, which automatically go to the next iteration
Else
'Code to perform the required action
End If
Next x

And many years later :D I used a "select" statement for a simple example:
For Each zThisRow In zRowRange
zRowNum = zThisRow.Row
Select Case zRowNum
Case 1 '- Skip header row and any other rows to skip -----
'- no need to put anything here -----
Case Else '- Rows to process -----
'- Process for stuff to do something here -----
End Select
Next zThisRow
You can make this as complex as you wish by turning each "if" result into a value (maybe a bit of over complex code would help explain :D ):
zSkip = 0
If 'condition1 = skip' Then zSkip = zSkip + 1
If 'condition2 = skip' Then zSkip = zSkip + 1
If 'condition3 = skip' Then zSkip = zSkip + 1
Select Case zRowNum
Case 0 '- Stuff to do -----
Case Else '- Stuff to skip -----
End Select
It's just a suggestion; have a great Christmas peeps!

This can also be solved using a boolean.
For Each rngCol In rngAll.Columns
doCol = False '<==== Resets to False at top of each column
For Each cell In Selection
If cell.row = 1 Then
If thisColumnShouldBeProcessed Then doCol = True
End If
If doCol Then
'Do what you want to do to each cell in this column
End If
Next cell
Next rngCol
For example, here is the full example that:
(1) Identifies range of used cells on worksheet
(2) Loops through each column
(3) IF column title is an accepted title, Loops through all cells in the column
Sub HowToSkipForLoopIfConditionNotMet()
Dim rngCol, rngAll, cell As Range, cnt As Long, doCol, cellValType As Boolean
Set rngAll = Range("A1").CurrentRegion
'MsgBox R.Address(0, 0), , "All data"
cnt = 0
For Each rngCol In rngAll.Columns
rngCol.Select
doCol = False
For Each cell In Selection
If cell.row = 1 Then
If cell.Value = "AnAllowedColumnTitle" Then doCol = True
End If
If doCol Then '<============== THIS LINE ==========
cnt = cnt + 1
Debug.Print ("[" & cell.Value & "]" & " / " & cell.Address & " / " & cell.Column & " / " & cell.row)
If cnt > 5 Then End '<=== NOT NEEDED. Just prevents too much demo output.
End If
Next cell
Next rngCol
End Sub
Note: If you didn't immediately catch it, the line If docol Then is your inverted CONTINUE. That is, if doCol remains False, the script CONTINUES to the next cell and doesn't do anything.
Certainly not as fast/efficient as a proper continue or next for statement, but the end result is as close as I've been able to get.

you can do that by simple way, simply change the variable value that used in for loop to the end value as shown in example
Sub TEST_ONLY()
For i = 1 To 10
ActiveSheet.Cells(i, 1).Value = i
If i = 5 Then
i = 10
End If
Next i
End Sub

I sometimes do a double do loop:
Do
Do
If I_Don't_Want_to_Finish_This_Loop Then Exit Do
Exit Do
Loop
Loop Until Done
This avoids having "goto spaghetti"

Related

How to delete a cell if it contains one (or more) Chr(10) characters, but no other characters?

I have a small script that sort of does what I need it to do, but I'm afraid at some point there will be more than 4 characters in a cell and I don't want to delete it. The logic that I want to employ is as follows:
If any cell in BB1:BB10 contains ONLY Chr(10) then move the contents of the cells below up one cell. Something like this
Public Sub CheckHisMethod()
Dim i As Integer
i = 1
For i = 10 To 1 Step -1
If Excel.ActiveSheet.Range("BB" & i).Value = Chr(10) Then ' or =vblf or =chr$(10)
Excel.ActiveSheet.Range("BB" & i).Delete Shift:=xlUp
End If
Next i
MsgBox "Done"
End Sub
But...I don't want to delete the Chr(10) from each cell, I only want to delete the cell, and move the cell below up one cell, if the cell contains ONLY Chr(10). How can I do that?
Please try the following. It removes all CHR(10) and then it checks if the length of the resulting string is 0, meaning all characters in the cell are CHR(10).
Public Sub CheckHisMethod()
Dim i As Integer
i = 1
For i = 10 To 1 Step -1
If Len(Replace(Excel.ActiveSheet.Range("BB" & i).Value,Chr(10),"")) = 0 Then ' or =vblf or =chr$(10)
Excel.ActiveSheet.Range("BB" & i).Delete Shift:=xlUp
End If
Next i
MsgBox "Done"
End Sub
I'd personally use a regular expression for this - it will likely be much faster than other string manipulations:
'Add a reference to Microsoft VBScript Regular Expressions 5.5
Public Sub CheckHisMethod()
Dim i As Integer
With New RegExp
.Pattern = "^[\n]+$"
.MultiLine = True
For i = 10 To 1 Step -1
If .Test(Excel.ActiveSheet.Range("BB" & i).Value) Then
Excel.ActiveSheet.Range("BB" & i).Delete Shift:=xlUp
End If
Next i
End With
MsgBox "Done"
End Sub

excel hyperlink to nothing

I've got a lot of hyperlinks and I want to assign a macros to each of them and Worksheet_FollowHyperlink captures only Inserted Hyperlinks but not the HYPERLINK() function. So I want my Inserted Hyperlinks refer to nothing so when I press them nothing happens. Or I want them to refer themselves. But when I just copy one to another cell it still refers to its parents cell. So I have to edit a new one so it refers to its new cell. And I've got hundreeds of hyperlinks to be copied and edited as well. I need that because I don't want the hyperlinks skip me to the parent hyperlink's cell.
Thanks in advance
You will be better off using the HYPERLINK() function. You can use it for what you want like this:
=HYPERLINK("#HyperlinkClick()", "Text you want to Display")
Notice the # at the beginning. This is important.
Now create a function called HyperlinkClick:
Function HyperlinkClick()
Set HyperlinkClick = Selection
'Do whatever you like here...
MsgBox "You clicked on cell " & Selection.Address(0, 0)
End Function
Be sure to place this function in a STANDARD CODE MODULE.
That's it.
I've just founded a solution. If I refer my Inserted Hyperlink to some cell in other sheet and then make it very hidden (xlSheetVeryHidden), it works just perfect. Now my hyperlinks refer to the Neverland and the macro captures them as well. Thank you all for your patiense.
Good solution Excel Hero but not for everything: I try to make a kind of outline but it's impossible to hide a row in the function: nothing happen! But if a make a direct call to the same code with a button, everything works fine. This is my test:
Function test()
Set test = Selection
Dim i, j, state As Integer
state = Selection.Value
i = Selection.Row + 1
j = i
If state = "6" Then
Do Until ActiveSheet.Cells(j, 7).Value = 1 Or ActiveSheet.Cells(j, 4).Value = ""
j = j + 1
Loop
ActiveSheet.Rows(i & ":" & j - 1).EntireRow.Hidden = True
Debug.Print "test group: " & i & ":" & j - 1
Else
Do Until ActiveSheet.Cells(j, 7).Value = 1 Or ActiveSheet.Cells(j, 4).Value = ""
j = j + 1
Loop
ActiveSheet.Rows(i & ":" & j - 1).EntireRow.Hidden = False
Debug.Print "test ungroup: " & i & ":" & j - 1
End If
End Function
My debug.print give me this:
test group: 4:26
Select a group of cells and run:
Sub HyperAdder()
For Each r In Selection
ActiveSheet.Hyperlinks.Add Anchor:=r, Address:="", SubAddress:=r.Parent.Name & "!" & r.Address(0, 0), TextToDisplay:="myself"
Next r
End Sub

Excel VBA delete entire row if cell in column D is empty

Can anyone walk me through how to write a script to delete the entire row if a cell in column D = "" on sheet 3 in range D13:D40.
Also, how to prevent the user from accidentally running the script again once those cells in the range are already deleted and other cells are now on the D13:D40 range?
Solution: This is working for me:
Sub DeleteRowsWithEmptyColumnDCell()
Dim rng As Range
Dim i As Long
Set rng = ThisWorkbook.ActiveSheet.Range("D13:D40")
With rng
' Loop through all cells of the range
' Loop backwards, hence the "Step -1"
For i = .Rows.Count To 1 Step -1
If .Item(i) = "" Then
' Since cell is empty, delete the whole row
.Item(i).EntireRow.Delete
End If
Next i
End With
End Sub
Explanation: Run a for loop through all cells in your Range in column D and delete the entire row if the cell value is empty. Important: When looping through rows and deleting some of them based on their content, you need to loop backwards, not forward. If you go forward and you delete a row, all subsequent rows get a different row number (-1). And if you have two empty cells next to each other, only the row of the first one will be deleted because the second one is moved one row up but the loop will continue at the next line.
No need for loops:
Sub SO()
Static alreadyRan As Integer
restart:
If Not CBool(alreadyRan) Then
With Sheets("Sheet3")
With .Range("D13:D40")
.AutoFilter 1, "="
With .SpecialCells(xlCellTypeVisible)
If .Areas.Count > 1 Then
.EntireRow.Delete
alreadyRan = alreadyRan + 1
End If
End With
End With
.AutoFilterMode = False
End With
Else
If MsgBox("procedure has already been run, do you wish to continue anyway?", vbYesNo) = vbYes Then
alreadyRan = 0
GoTo restart:
End If
End If
End Sub
Use AutoFilter to find blank cells, and then use SpecialCells to remove the results. Uses a Static variable to keep track of when the procedure has been run.
Here's my take on it. See the comments in the code for what happens along the way.
Sub deleterow()
' First declare the variables you are going to use in the sub
Dim i As Long, safety_net As Long
' Loop through the row-numbers you want to change.
For i = 13 To 40 Step 1
' While the value in the cell we are currently examining = "", we delete the row we are on
' To avoid an infinite loop, we add a "safety-net", to ensure that we never loop more than 100 times
While Worksheets("Sheet3").Range("D" & CStr(i)).Value = "" And safety_net < 100
' Delete the row of the current cell we are examining
Worksheets("Sheet3").Range("D" & CStr(i)).EntireRow.Delete
' Increase the loop-counter
safety_net = safety_net + 1
Wend
' Reset the loop-counter
safety_net = 0
' Move back to the top of the loop, incrementing i by the value specified in step. Default value is 1.
Next i
End Sub
To prevent a user from running the code by accident, I'd probably just add Option Private Module at the top of the module, and password-protect the VBA-project, but then again it's not that easy to run it by accident in the first place.
This code executes via a button on the sheet that, once run, removes the button from the worksheet so it cannot be run again.
Sub DeleteBlanks()
Dim rw As Integer, buttonID As String
buttonID = Application.Caller
For rw = 40 To 13 Step -1
If Range("D" & rw) = "" Then
Range("D" & rw).EntireRow.Delete
End If
Next rw
ActiveSheet.Buttons(buttonID).Delete
End Sub
You'll need to add a button to your spreadsheet and assign the macro to it.
There is no need for loops or filters to find the blank cells in the specified Range. The Range.SpecialCells property can be used to find any blank cells in the Range coupled with the Range.EntireRow property to delete these. To preserve the run state, the code adds a Comment to the first cell in the range. This will preserve the run state even if the Workbook is closed (assuming that it has been saved).
Sub DeleteEmpty()
Dim ws As Excel.Worksheet
Set ws = ActiveSheet ' change this as is appropriate
Dim sourceRange As Excel.Range
Set sourceRange = ws.Range("d13:d40")
Dim cmnt As Excel.Comment
Set cmnt = sourceRange.Cells(1, 1).Comment
If Not cmnt Is Nothing Then
If cmnt.Text = "Deleted" Then
If MsgBox("Do you wish to continue with delete?", vbYesNo, "Already deleted!") = vbNo Then
Exit Sub
End If
End If
End If
Dim deletedThese As Excel.Range
On Error Resume Next
' the next line will throw an error if no blanks cells found
' hence the 'Resume Next'
Set deletedThese = sourceRange.SpecialCells(xlCellTypeBlanks)
On Error GoTo 0
If Not deletedThese Is Nothing Then
deletedThese.EntireRow.Delete
End If
' for preserving run state
If cmnt Is Nothing Then Set cmnt = sourceRange.Cells(1, 1).AddComment
cmnt.Text "Deleted"
cmnt.Visible = False
End Sub
I've recently had to write something similar to this. I'm not sure that the code below is terribly professional, as it involves storing a value in cell J1 (obviously this can be changed), but it will do the job you require. I hope this helps:
Sub ColD()
Dim irow As long
Dim strCol As String
Sheets("sheet2").Activate
If Cells(1, 10) = "" Then
lrun = " Yesterday."
Else: lrun = Cells(1, 10)
End If
MsgBox "This script was last run: " & lrun & " Are you sure you wish to continue?", vbYesNo
If vbYes Then
For irow = 40 To 13 step -1
strCol = Cells(irow, 4).Value
If strCol = "" Then
Cells(irow, 4).EntireRow.Delete
End If
Next
lrun = Now()
Cells(1, 10) = lrun
Else: Exit Sub
End If
End Sub

Excel VBA - For Loop taking far too long to execute

I have a script which I have designed in order to hide rows that do not contain data, the script looks through column A starting from Row 7. If it finds rows that do not contain values, it will hide those rows from sight. Unfortunately this script takes over 1 minute to run on large sheets in its present form.
Does anybody have suggestions on how to re-write this script in order to make it faster? It needs to run in 5 seconds max
Sub hideAllRows()
Dim Checklist As Variant
UnlockSheet
Call Show_Hide("Row", "7:519", True)
Call Show_Hide("Row", "529:1268", True)
Checklist = ActiveSheet.Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row).Value
For I = UBound(Checklist, 1) To LBound(Checklist, 1) Step -1
If Checklist(I, 1) <> "" Then
Rows(I & ":" & I).Select
Selection.EntireRow.Hidden = False
End If
Next I
I have edited your code in order to make things simpler.
One of the issues is that your code is firing events "like crazy" (each time you do a Select, an event is fired).
A. If you want to use your code as is, I suggest you add at the beginning
Application.EnableEvents = False
and add in the last line:
Application.EnableEvents = true
B. I suggest that you do the hiding "in one blow", after the loop has ended. Here is how:
Dim Checklist As Variant
dim sRowsToHide as string
UnlockSheet
Application.ScreenUpdating = False
Call Show_Hide("Row", "7:519", True)
Call Show_Hide("Row", "529:1268", True)
Checklist = ActiveSheet.Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row).Value
For I = UBound(Checklist, 1) To LBound(Checklist, 1) Step -1
If Checklist(I, 1) <> "" Then
if sRowsToHide = "" then
sRowsToHide = I & ":" & I
else
sRowsToHide = sRowsToHide & "," & I & ":" & I
end if
End If
Next I
ActiveSheet.Range(sRowsToHide).EntireRow.Hidden = True
Application.ScreenUpdating = True
You can use the following line to see how such a thing would work:
ActiveSheet.Range("2:2,14:14,17:17,19:19").EntireRow.Hidden = True
You can try using ScreenUpdating, it will only update the sheet once the loop is done instead of updating every time
Dim Checklist As Variant
UnlockSheet
Application.ScreenUpdating = False
Call Show_Hide("Row", "7:519", True)
Call Show_Hide("Row", "529:1268", True)
Checklist = ActiveSheet.Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row).Value
For I = UBound(Checklist, 1) To LBound(Checklist, 1) Step -1
If Checklist(I, 1) <> "" Then
Rows(I & ":" & I).Select
Selection.EntireRow.Hidden = False
End If
Next I
Application.ScreenUpdating = True
The following will hide all rows that have constants (e.g. typed values) in column A.
Sub hide_A_values()
With ActiveSheet.Columns("A")
.SpecialCells(xlCellTypeConstants).EntireRow.Hidden = True
End With
End Sub
This next one will hide all rows that have formulas in column A.
Sub hide_A_values()
With ActiveSheet.Columns("A")
.SpecialCells(xlCellTypeFormulas).EntireRow.Hidden = True
End With
End Sub
Finally, this will hide all rows that have constants (e.g. typed values) or formulas in column A.
Sub hide_A_values()
With ActiveSheet.Columns("A")
Union(.SpecialCells(xlCellTypeConstants), .SpecialCells(xlCellTypeFormulas)).EntireRow.Hidden = True
End With
End Sub
The problem is that you have to provide error control or risk dealing with the dreaded Runtime error: 1004 No cells were found if there are no constants or formulas to hide. On Error Resume Next typically takes care of this.
Sub hide_A_values()
With ActiveSheet.Columns("A")
On Error Resume Next
.SpecialCells(xlCellTypeConstants).EntireRow.Hidden = True
.SpecialCells(xlCellTypeFormulas).EntireRow.Hidden = True
On Error GoTo 0
End With
End Sub
The only case not covered by those is formulas returning empty strings (e.g. "") which are not considered truly blank.

Why is this program, which should sum each column, stopping after only one column?

This program creates a table of numbers, and then attempts to sum it up, row by row. I'm using IsBlank() to test if the topmost cell is blank. If it is blank, it should end the loop, but if it isn't, the loop should keep going. However, it keeps ending after the first time through the loop. Why is that?
I have a feeling it's really obvious.
Edit: I should note that the whole "counter" thing is in there because I was going to start playing around with that if this worked. And it didn't work, so I'm here!
Option Explicit
Dim Counter As Long
Dim i As Long
Dim col As Long
Dim row As Long
Sub SumRange()
For col = 1 To 8
For row = 1 To 6
Cells(row, col) = Rnd
Next row
Next col
Counter = 6
For i = 1 To 9
If IsEmpty(Cells(1, i)) = False Then
Cells(Counter + 1, i) = Application.WorksheetFunction.Sum(Range(Cells(1, i), Cells(Counter, i)))
Else
End If
End
Next
MsgBox Cells(4, 5)
End Sub
There are two problems:
The End statement is incorrect. If I remember correctly, End means to end the program. You have to explicitly state what you are ending (End If, End With, ...). In this case you mean End If.
You need to use Exit For to jump out of the for loop. I think you mean it to be where your current End If statement is.
I'm not sure what you're trying to do, but you can also consider using a while loop with the condition While Not IsEmpty(Cells(1, i)) and then increment the counter i from within the loop. To me this feels a little better than a for loop with a jump in it.
Remove Else and End from your code (the lines that only contain those statements) and your loop executes nine times.
The End Statement instructs VBA to ... end your code. So it simply exits.
I strongly recommend refactoring your code, it can be made much more efficient:
Sub SumRange()
Dim values(1 To 6, 1 To 8) As Double
Dim i As Long, j As Long
' populate array
For i = LBound(values) To UBound(values)
For j = LBound(values, 2) To UBound(values, 2)
values(i, j) = Rnd
Next j
Next i
' blast array onto worksheet in one go
Range("A1").Resize(UBound(values), UBound(values, 2)).value = values
' add sum formulas in one go
Range("A1").Resize(, UBound(values, 2)).Offset(UBound(values)).FormulaR1C1 = _
"=SUM(R[-" & UBound(values) & "]C[0]:R[-1]C[0])"
MsgBox Cells(4, 5)
End Sub