My code works on the first cell its set to and none of the others

Question

So the title says it all. I've written this short code to try and take website URL's and remove unwanted aspects to make them all nice and pretty for clients. However, for some reason this sort of template I've been using a lot has failed me this time around by only giving the royal treatment to B2 the only cell directly called out in the code. I debugs fine and runs fine just not accomplishing what I'd like it to. Not having an error makes this hard to discern what the problem is. If any of you can see whats going on here please do let me know.

Sub Website()
Application.ScreenUpdating = False

Range("B2").Select

Dim TitleString As Range, cel As Range
Set TitleString = ActiveCell
Do Until IsEmpty(ActiveCell)
  For Each cel In TitleString
     If InStr(1, cel.Value, "https://") > 0 Then '
        Selection.Replace What:="https://", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
     End If

    If InStr(1, cel.Value, "http://") > 0 Then
        Selection.Replace What:="http://", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
     End If

     If InStr(1, cel.Value, "/") > 0 Then
        Selection.Replace What:="/*", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
     End If

     If InStr(1, cel.Value, "www.") > 0 Then
        Exit For

     ElseIf InStr(1, cel.Value, "www.") = 0 Then
        ActiveCell.Value = "www." & ActiveCell.Value

     Exit For
     End If

  Next cel
 ActiveCell.Offset(1, 0).Select
Loop


Application.ScreenUpdating = True
End Sub

Using Activecell can be an issue in itself...http://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba-macros — Rdster, Nov 22 '16 at 21:30
@Rdster I've heard it can be an issue and I looked at that link however my problem is that my data sets range from 1,000 to 500k+ and it seems like an array off 500k would take much longer to process than something like this that runs each thing on an active cell. I may be wrong though. — Medicated Gorilla, Nov 22 '16 at 21:43

score 0 · Answer 1 · answered Nov 22 '16 at 21:34

This looks like it's failing because you set the TitleString range outside of the do loop so there's only one cell to loop through. You can simplify this a lot by removing the do loop entirely. Instead declare the cells you want to loop through as a range initially.

Sub Website()
    Application.ScreenUpdating = False

    Range("B2").Select
    Dim rng As Range
    Dim cel As Range

    Set rng = Range(Selection, Selection.End(xlDown))

    For Each cel In rng

        ' IF STATEMENTS

    Next

    Application.Screenupdating = True
End Sub

score 0 · Accepted Answer · answered Nov 22 '16 at 21:53

Anytime one uses Select it forces vba to slow down.

This avoids select as well as loops.

Sub Website()
Dim rng As Range
Dim ws As Worksheet

Application.ScreenUpdating = False
Set ws = ActiveSheet
Set rng = ws.Range(ws.Cells(2, 2), ws.Cells(ws.Rows.Count, 2).End(xlUp))
rng.Replace "https://", ""
rng.Replace "http://", ""
rng.Replace "/*", ""
rng.Replace "www.", ""
rng.Value = Evaluate("INDEX(""www.""&" & rng.Address & ",)")

Application.ScreenUpdating = True
End Sub

Before:

After:

My code works on the first cell its set to and none of the others

2 Answers2