Why isn't my loop looping?

J

jmpatrick

Active Member
Joined
Aug 17, 2016
Messages
485
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

Create a Pivot Table on a Map
If your data has zip codes, postal codes, or city names, select the data and use Insert, 3D Map. (Found to right of chart icons).
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

E
  • Question Question
VBA - If Cell IsDate and Another Column is a formula then make Cell a hyperlink
2
Replies
10
Views
207
Alex Blakenburg
A
E
  • Locked
  • Question Question
VBA - If Cell IsDate and Another Column is a formula then make Cell a hyperlink
Replies
2
Views
102
Fluff
Fluff
I
  • Question Question
Advice to remove old code for a new code
Replies
2
Views
212
ipbr21054
I
E
  • Question Question
Can you combine these 2 macros ?
Replies
6
Views
233
excel4us
E
J
  • Solved
My If/Then isn't working
Replies
3
Views
409
Joe4
Joe4

Forum statistics

Threads
1,224,820
Messages
6,181,159
Members
453,021
Latest member
Justyna P

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