VBA to Convert Cell Values to Hyperlinks

[JohanGduToit]

Greetings Experts,

I am having partial success in converting text in a column to 'clickable' hyperlinks. The procedure below is being called with a path and filename from an MS Access application. The procedure completes successfully and reformats all as expected; but if I call the procedure a 2nd or 3rd time, the code fails on "For Each rCell In .Application..." (See "***Start of Problematic Code***" below) with a Run-time
error '1004' - Method 'Rows' of object '_Global' failed.

If I close and reopen the MS Access application and call the procedure again, it will run without generating an error. I think it may have something to do with the fact that the piece of code that handles the hyperlink conversion and the deletion of Column "F" afterwards is not within a 'With' and 'End With'.

You are most welcome to amend/optimize code below. I am no expert at this. The nett result I would like to achieve is just for cells (with values) in column "I" to be converted to a hyperlinks and named the same as values (WaybillNo's) in Column "F". Once hyperlinks have been named, column "F" should be deleted.

Any assistance will be most welcomed!

Many Thanks in advance.

Public Sub FormatSummary(sFile As String)

    Dim xlApp As Object
    Dim xlSheet As Object
    
    Dim rCell As Range
    
    Application.SetOption "Show Status Bar", True
    vStatusBar = SysCmd(acSysCmdSetStatus, "Formatting Proof of Delivery Summary file... Please wait.")

    Set xlApp = CreateObject("Excel.Application")
    Set xlSheet = xlApp.Workbooks.Open(sFile).Sheets(1)

    With xlApp
        .Rows("2:2").Select
        .ActiveWindow.SplitColumn = 0
        .ActiveWindow.SplitRow = 1
        .ActiveWindow.FreezePanes = True
        .Rows("1:1").Select
        .Selection.AutoFilter
        .Range("A1:I1").Select
        With .Selection.Interior
            .Pattern = xlSolid
            .ThemeColor = 5
            .TintAndShade = 0
            .PatternTintAndShade = 0
        End With
        .Columns("A:I").Select
        .Columns("A:I").EntireColumn.AutoFit
        .Range("A:A,B:B,E:E,F:F,G:G,H:H,I:I").Select
        With .Selection
            .HorizontalAlignment = xlCenter
        End With
        
    '***START OF PROBLEMATIC CODE***
        'For Each rCell In .Application.Range("I2:I" & .Cells(Rows.Count, "I").End(xlUp).Row)
            'If (IsEmpty(rCell.Value) = False) Then
                '.ActiveSheet.Hyperlinks.Add Anchor:=rCell, Address:=rCell.Value, TextToDisplay:=rCell.Offset(, -3).Value
            'End If
        'Next rCell
        
        '.Columns("F:F").Select
        'With Selection
        '    .Delete Shift:=xlToLeft
        'End With
    '***END OF PROBLEMATIC CODE***
        
        .Range("A2").Select
        .ActiveWorkbook.Save
        .ActiveWorkbook.Close
        .Quit
    End With
    
    vStatusBar = SysCmd(acSysCmdClearStatus)

    Set xlSheet = Nothing
    Set xlApp = Nothing

End Sub

 

[JohanGduToit]

I'm getting a lot of results stating 'Range not being referenced' upon searching "Method 'Rows' of object '_Global' failed'; but I have now idea how to amend my existing code to fix it.

 

[JohanGduToit]

I have managed to resolve the issue... corrected code in bold below:

Public Sub FormatSummary(sFile As String)

    Dim xlApp As Object
    Dim xlSheet As Object
   
    Dim rCell As Range
   
    Application.SetOption "Show Status Bar", True
    vStatusBar = SysCmd(acSysCmdSetStatus, "Formatting Proof of Delivery Summary file... Please wait.")

    Set xlApp = CreateObject("Excel.Application")
    Set xlSheet = xlApp.Workbooks.Open(sFile).Sheets(1)

    With xlApp
        .Rows("2:2").Select
        .ActiveWindow.SplitColumn = 0
        .ActiveWindow.SplitRow = 1
        .ActiveWindow.FreezePanes = True
        .Rows("1:1").Select
        .Selection.AutoFilter
        .Range("A1:I1").Select
        With .Selection.Interior
            .Pattern = xlSolid
            .ThemeColor = 5
            .TintAndShade = 0
            .PatternTintAndShade = 0
        End With
        .Columns("A:I").Select
        .Columns("A:I").EntireColumn.AutoFit
        .Range("A:A,B:B,E:E,F:F,G:G,H:H,I:I").Select
        With .Selection
            .HorizontalAlignment = xlCenter
        End With
       
        For Each rCell In .Application.Range("I2:I" & .Cells(.Application.Rows.Count, "I").End(-4162).Row)
           If (IsEmpty(rCell.Value) = False) Then
               .ActiveSheet.Hyperlinks.Add Anchor:=rCell, Address:=rCell.Value, TextToDisplay:=rCell.Offset(, -3).Value
           End If
        Next rCell
       
        .Columns("F:F").Select
        With .Selection
            .Delete Shift:=xlToLeft
        End With
       
        .Range("A2").Select
        .ActiveWorkbook.Save
        .ActiveWorkbook.Close
        .Quit
    End With
   
    vStatusBar = SysCmd(acSysCmdClearStatus)

    Set xlSheet = Nothing
    Set xlApp = Nothing

End Sub