Why isn't my loop looping?

J

jmpatrick

Active Member
Joined
Aug 17, 2016
Messages
482
Office Version
  1. 365
Platform
  1. Windows
Happy Friday!

The code below processes the first row and never moves to the second row. What am I doing wrong here?

VBA Code: 
Sub TestForHyperlinkAndFix()

Settings.MessageReturn.Value = "Rebuilding all Hyperlinks."
Settings.Repaint

Application.EnableEvents = False
Application.ScreenUpdating = False
Application.DisplayAlerts = False

ActiveSheet.Unprotect
Sheets("Hyperlinks").Visible = True
    
Sheets("Calendar").Range("J5").Select

Dim i As Long
Dim LastRow As Long

LastRow = Range("A" & Rows.Count).End(xlUp).Row

For i = 1 To LastRow Step 1

If Cells(ActiveCell.Row, "J").Hyperlinks.Count > 0 Then
Range(Cells(Selection.Row, 10).Address).Select
    Range(ActiveCell.Address).Name = "StartCell"
    Sheets("Hyperlinks").Range("F1") = Sheets("Calendar").Range("StartCell")
    Sheets("Hyperlinks").Range("A1") = Sheets("Calendar").Range("C" & ActiveCell.Row).Value
    
    Sheets("Calendar").Select
    Application.GoTo "StartCell"
    
    ThisWorkbook.Names("StartCell").Delete
    
    Dim newRange As Range
    Set newRange = Range(ActiveCell, ActiveCell.Offset(NumRows, numCols))
    With ActiveSheet
   .Hyperlinks.Add Anchor:=newRange, _
      Address:=Sheets("Hyperlinks").Range("I1"), TextToDisplay:=ActiveCell.Text
      End With
Else
End If
    
Next i

Sheets("Hyperlinks").Visible = False

'Protect Calendar
ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:=False, AllowFormattingCells:=True, AllowFormattingColumns:=True, AllowFormattingRows:=True, AllowInsertingColumns:=True, AllowInsertingRows:=True, AllowInsertingHyperlinks:=True, AllowDeletingColumns:=True, AllowDeletingRows:=True, AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:=True

Settings.MessageReturn.Value = "All Hyperlinks successfully rebuilt."

Application.EnableEvents = True
Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub
 

Excel Facts

Why does 9 mean SUM in SUBTOTAL?
It is because Sum is the 9th alphabetically in Average, Count, CountA, Max, Min, Product, StDev.S, StDev.P, Sum, VAR.S, VAR.P.
Sort by date Sort by votes
You are looping through the rows using "i". But the code inside your loop never references i or increases the values.
You are referencing "ActiveCell", but never change the ActiveCell in your loop.

By the way, I would recommend NOT moving the ActiveCell in the loop. That will slow down the code immensely.
You usually do not need to select the cells to work with them.
Just replace "ActiveCell.Row" with i, i.e.
change this:
VBA Code: 
If Cells(ActiveCell.Row, "J").Hyperlinks.Count > 0 Then
to this:
VBA Code: 
If Cells(i, "J").Hyperlinks.Count > 0 Then
 
Upvote 0
First of all, I cannot run your code, because I get a "compile error - variable not defined" for "Settings.MessageReturn.Value"

So maybe you could post some more code or data, otherwise I'm not able to help.
 
Upvote 0
Joe4 said:
You are looping through the rows using "i". But the code inside your loop never references i or increases the values.
You are referencing "ActiveCell", but never change the ActiveCell in your loop.

By the way, I would recommend NOT moving the ActiveCell in the loop. That will slow down the code immensely.
You usually do not need to select the cells to work with them.
Just replace "ActiveCell.Row" with i, i.e.
change this:
VBA Code: 
If Cells(ActiveCell.Row, "J").Hyperlinks.Count > 0 Then
to this:
VBA Code: 
If Cells(i, "J").Hyperlinks.Count > 0 Then
Click to expand...

Here's the complete code with changes you suggested. It still will not move to the next row down. I'm missing something here.

VBA Code: 
Sub TestForHyperlinkAndFix()

Application.EnableEvents = False
Application.ScreenUpdating = False
Application.DisplayAlerts = False

ActiveSheet.Unprotect
Sheets("Hyperlinks").Visible = True
    
Sheets("Calendar").Range("J5").Activate
Range(ActiveCell.Address).Name = "StartCell"

Dim i As Long
Dim LastRow As Long

LastRow = Range("A" & Rows.Count).End(xlUp).Row

For i = 1 To LastRow Step 1

If Cells(i, "J").Hyperlinks.Count > 0 Then
Range(Cells(Selection.Row, 10).Address).Activate
Range(ActiveCell.Address).Name = "StartCell"

    Sheets("Hyperlinks").Range("F1") = Sheets("Calendar").Range("StartCell")
    Sheets("Hyperlinks").Range("A1") = Sheets("Calendar").Range("C" & ActiveCell.Row).Value
    
    ThisWorkbook.Names("StartCell").Delete
    
    Dim newRange As Range
    Set newRange = Range(ActiveCell, ActiveCell.Offset(NumRows, numCols))
    With ActiveSheet
   .Hyperlinks.Add Anchor:=newRange, _
      Address:=Sheets("Hyperlinks").Range("I1"), TextToDisplay:=ActiveCell.Text
      End With
Else
End If

If Cells(i, "K").Hyperlinks.Count > 0 Then
Range(Cells(Selection.Row, 11).Address).Activate
Range(ActiveCell.Address).Name = "StartCell"

    Sheets("Hyperlinks").Range("F1") = Sheets("Calendar").Range("StartCell")
    Sheets("Hyperlinks").Range("A1") = Sheets("Calendar").Range("C" & ActiveCell.Row).Value
    
    ThisWorkbook.Names("StartCell").Delete
    
    Set newRange = Range(ActiveCell, ActiveCell.Offset(NumRows, numCols))
    With ActiveSheet
   .Hyperlinks.Add Anchor:=newRange, _
      Address:=Sheets("Hyperlinks").Range("I1"), TextToDisplay:=ActiveCell.Text
      End With
Else
End If

If Cells(i, "L").Hyperlinks.Count > 0 Then
Range(Cells(Selection.Row, 12).Address).Activate
Range(ActiveCell.Address).Name = "StartCell"

    Sheets("Hyperlinks").Range("F1") = Sheets("Calendar").Range("StartCell")
    Sheets("Hyperlinks").Range("A1") = Sheets("Calendar").Range("C" & ActiveCell.Row).Value
    
    ThisWorkbook.Names("StartCell").Delete
    
    Set newRange = Range(ActiveCell, ActiveCell.Offset(NumRows, numCols))
    With ActiveSheet
   .Hyperlinks.Add Anchor:=newRange, _
      Address:=Sheets("Hyperlinks").Range("I1"), TextToDisplay:=ActiveCell.Text
      End With
Else
End If

If Cells(i, "M").Hyperlinks.Count > 0 Then
Range(Cells(Selection.Row, 13).Address).Activate
Range(ActiveCell.Address).Name = "StartCell"

    Sheets("Hyperlinks").Range("F1") = Sheets("Calendar").Range("StartCell")
    Sheets("Hyperlinks").Range("A1") = Sheets("Calendar").Range("C" & ActiveCell.Row).Value
    
    ThisWorkbook.Names("StartCell").Delete
    
    Set newRange = Range(ActiveCell, ActiveCell.Offset(NumRows, numCols))
    With ActiveSheet
   .Hyperlinks.Add Anchor:=newRange, _
      Address:=Sheets("Hyperlinks").Range("I1"), TextToDisplay:=ActiveCell.Text
      End With
Else
End If

If Cells(i, "N").Hyperlinks.Count > 0 Then
Range(Cells(Selection.Row, 14).Address).Activate
Range(ActiveCell.Address).Name = "StartCell"

    Sheets("Hyperlinks").Range("F1") = Sheets("Calendar").Range("StartCell")
    Sheets("Hyperlinks").Range("A1") = Sheets("Calendar").Range("C" & ActiveCell.Row).Value
    
    ThisWorkbook.Names("StartCell").Delete
    
    Set newRange = Range(ActiveCell, ActiveCell.Offset(NumRows, numCols))
    With ActiveSheet
   .Hyperlinks.Add Anchor:=newRange, _
      Address:=Sheets("Hyperlinks").Range("I1"), TextToDisplay:=ActiveCell.Text
      End With
Else
End If

If Cells(i, "O").Hyperlinks.Count > 0 Then
Range(Cells(Selection.Row, 15).Address).Activate
Range(ActiveCell.Address).Name = "StartCell"

    Sheets("Hyperlinks").Range("F1") = Sheets("Calendar").Range("StartCell")
    Sheets("Hyperlinks").Range("A1") = Sheets("Calendar").Range("C" & ActiveCell.Row).Value
    
    ThisWorkbook.Names("StartCell").Delete
    
    Set newRange = Range(ActiveCell, ActiveCell.Offset(NumRows, numCols))
    With ActiveSheet
   .Hyperlinks.Add Anchor:=newRange, _
      Address:=Sheets("Hyperlinks").Range("I1"), TextToDisplay:=ActiveCell.Text
      End With
Else
End If

If Cells(i, "P").Hyperlinks.Count > 0 Then
Range(Cells(Selection.Row, 15).Address).Activate
Range(ActiveCell.Address).Name = "StartCell"

    Sheets("Hyperlinks").Range("F1") = Sheets("Calendar").Range("StartCell")
    Sheets("Hyperlinks").Range("A1") = Sheets("Calendar").Range("C" & ActiveCell.Row).Value
    Sheets("Hyperlinks").Range("L1") = Sheets("Calendar").Range("AM" & ActiveCell.Row).Value
    
    ThisWorkbook.Names("StartCell").Delete
    
    Set newRange = Range(ActiveCell, ActiveCell.Offset(NumRows, numCols))
    With ActiveSheet
   .Hyperlinks.Add Anchor:=newRange, _
      Address:=Sheets("Hyperlinks").Range("I1"), TextToDisplay:=ActiveCell.Text
      End With
           
    Sheets("Hyperlinks").Range("L1") = ""
    
Else
End If
    
If Cells(i, "Q").Hyperlinks.Count > 0 Then
Range(Cells(Selection.Row, 17).Address).Activate
Range(ActiveCell.Address).Name = "StartCell"

    Sheets("Hyperlinks").Range("F1") = Sheets("Calendar").Range("StartCell")
    Sheets("Hyperlinks").Range("A1") = Sheets("Calendar").Range("C" & ActiveCell.Row).Value
    
    ThisWorkbook.Names("StartCell").Delete
    
    Set newRange = Range(ActiveCell, ActiveCell.Offset(NumRows, numCols))
    With ActiveSheet
   .Hyperlinks.Add Anchor:=newRange, _
      Address:=Sheets("Hyperlinks").Range("I1"), TextToDisplay:=ActiveCell.Text
      End With
Else
End If
      
If Cells(i, "AC").Hyperlinks.Count > 0 Then
Range(Cells(Selection.Row, 29).Address).Activate
Range(ActiveCell.Address).Name = "StartCell"

    Sheets("Hyperlinks").Range("F1") = Sheets("Calendar").Range("StartCell")
    Sheets("Hyperlinks").Range("A1") = Sheets("Calendar").Range("C" & ActiveCell.Row).Value
    
    ThisWorkbook.Names("StartCell").Delete
    
    Set newRange = Range(ActiveCell, ActiveCell.Offset(NumRows, numCols))
    With ActiveSheet
   .Hyperlinks.Add Anchor:=newRange, _
      Address:=Sheets("Hyperlinks").Range("I1"), TextToDisplay:=ActiveCell.Text
      End With
Else
End If
    
Next i

'Protect Calendar
ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:=False, AllowFormattingCells:=True, AllowFormattingColumns:=True, AllowFormattingRows:=True, AllowInsertingColumns:=True, AllowInsertingRows:=True, AllowInsertingHyperlinks:=True, AllowDeletingColumns:=True, AllowDeletingRows:=True, AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:=True

Application.EnableEvents = True
Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub
 
Upvote 0
You need to update every instance of "Selection" and "ActiveCell" in your loop.
 
Upvote 0
You must log in or register to reply here.

Similar threads

I
  • Question Question
Advice to remove old code for a new code
Replies
2
Views
202
ipbr21054
I
E
  • Question Question
Can you combine these 2 macros ?
Replies
6
Views
188
excel4us
E
J
  • Solved
My If/Then isn't working
Replies
3
Views
402
Joe4
Joe4
J
  • Solved
Referring to Named Range in If InStr?
Replies
8
Views
530
Akuini
Akuini
D
  • Solved
Auto Date Stamp
Replies
3
Views
648
Joe4
Joe4

Forum statistics

Threads
1,223,888
Messages
6,175,207
Members
452,618
Latest member
Tam84

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top