简体   繁体   中英

Excel VBA - Error Adding Hyperlink to Another Workbook

I have written this code to take data from one workbook, put it into an array, then place the data in an empty row in another workbook. It works until it gets to i=25 in the For loop where it adds the hyperlink. The hyperlink is actually correctly added, and functions properly, but when I step through the line it gives me a "Application-Defined or Object-Define Error" even though the line added the hyperlink correctly.

Any help would be greatly appreciated. I've been stuck on this for a few days, and have tried many adjustments.

Private Sub CopyDataToMatrix()

'This macro copies the data from the process sheet & automatically pastes it into
'the matrix.

    Dim wb1 As Workbook
    Dim wb2 As Workbook
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim Data(1 To 26)
    Dim EmptyRow As Range
    Dim strSearch As String
    Dim rngSearch As Range
    Dim rowNum As Integer

    Set wb1 = ActiveWorkbook
    Set wb2 = Workbooks.Open("***ForPrivacy***")

    Set ws1 = wb1.Sheets("ProcessData")
    Set ws2 = wb2.Sheets("2016")

    'Put all of the data into an array:
     Data(1) = ws1.Range("B57").Value     
     Data(2) = ws1.Range("B3").Value      
     Data(3) = ws1.Range("B4").Value      
     Data(4) = ws1.Range("B5").Value      
     Data(5) = ws1.Range("F7").Value      
     Data(6) = ws1.Range("B6").Value      
     Data(7) = ws1.Range("B7").Value      
     Data(8) = ws1.Range("F8").Value    
     Data(9) = ws1.Range("B8").Value     
     Data(10) = ws1.Range("B9").Value    
     Data(11) = ws1.Range("B10").Value    
     Data(12) = ws1.Range("F9").Value     
     Data(13) = ws1.Range("F4").Value    
     Data(14) = ws1.Range("F5").Value     
     Data(15) = ws1.Range("F6").Value    
     Data(16) = ws1.Range("G4").Value     
     Data(17) = ws1.Range("G5").Value     
     Data(18) = ws1.Range("G6").Value     
     Data(19) = ws1.Range("H4").Value     
     Data(20) = ws1.Range("H5").Value    
     Data(21) = ws1.Range("H6").Value     
     Data(22) = ws1.Range("I4").Value    
     Data(23) = ws1.Range("I5").Value     
     Data(24) = ws1.Range("I5").Value     
     Data(25) = Left(wb1.Name, 8)         


 'IM MATRIX:
    'Look to see if the row already exists in IM Matrix with the current file name, and if so overwrite it:
    strSearch = Left(wb1.Name, 8)
    Set rngSearch = ws2.Range("Y:Y")

    If Application.CountIf(rngSearch, strSearch) > 0 Then
        rowNum = Application.Match(strSearch, rngSearch, 0)
        With ws2
            Set EmptyRow = .Cells(rowNum, 1)
                For i = LBound(Data) To 24
                    EmptyRow.Offset(0, i - 1).Value = Application.Index(Data, i)
            Next i
                For i = 25 To 25
                    EmptyRow.Offset(0, i - 1).Value = ws2.Hyperlinks.Add(EmptyRow.Offset(0, i - 1), wb1.FullName, , "Click to go to IML file.", Data(i))
            Next i
        End With

     'If the file name isn't already in IM Matrix, then enter data in new row:
     Else
        With ws2
            Set EmptyRow = .Cells(.Rows.Count, 1).End(xlUp).Offset(1)
                For i = LBound(Data) To 24
                    EmptyRow.Offset(0, i - 1).Value = Application.Index(Data, i)
            Next i
                For i = 25 To 25
                    **''HERE IS WHERE THE CODE BUGS:**
                    **EmptyRow.Offset(0, i - 1).Value = ws2.Hyperlinks.Add(EmptyRow.Offset(0, i - 1), wb1.FullName, , "Click to go to IML file.", Data(i))**
            Next i
        End With
    End If

     'Close & save IM Matrix file:
     wb2.Close SaveChanges:=True


End Sub

Here is the solution that worked with the help of @JMichael:

Private Sub CopyDataToMatrix()

'This macro copies the data from the process sheet & automatically pastes it into
'the matrix.

    Dim wb1 As Workbook
    Dim wb2 As Workbook
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim Data(1 To 26)
    Dim EmptyRow As Range
    Dim strSearch As String
    Dim rngSearch As Range
    Dim rowNum As Integer

    Set wb1 = ActiveWorkbook
    Set wb2 = Workbooks.Open("***ForPrivacy***")

    Set ws1 = wb1.Sheets("ProcessData")
    Set ws2 = wb2.Sheets("2016")

    'Put all of the data into an array:
     Data(1) = ws1.Range("B57").Value     
     Data(2) = ws1.Range("B3").Value      
     Data(3) = ws1.Range("B4").Value      
     Data(4) = ws1.Range("B5").Value      
     Data(5) = ws1.Range("F7").Value      
     Data(6) = ws1.Range("B6").Value      
     Data(7) = ws1.Range("B7").Value      
     Data(8) = ws1.Range("F8").Value    
     Data(9) = ws1.Range("B8").Value     
     Data(10) = ws1.Range("B9").Value    
     Data(11) = ws1.Range("B10").Value    
     Data(12) = ws1.Range("F9").Value     
     Data(13) = ws1.Range("F4").Value    
     Data(14) = ws1.Range("F5").Value     
     Data(15) = ws1.Range("F6").Value    
     Data(16) = ws1.Range("G4").Value     
     Data(17) = ws1.Range("G5").Value     
     Data(18) = ws1.Range("G6").Value     
     Data(19) = ws1.Range("H4").Value     
     Data(20) = ws1.Range("H5").Value    
     Data(21) = ws1.Range("H6").Value     
     Data(22) = ws1.Range("I4").Value    
     Data(23) = ws1.Range("I5").Value     
     Data(24) = ws1.Range("I5").Value     
     Data(25) = Left(wb1.Name, 8)         


 'IM MATRIX:
    'Look to see if the row already exists in IM Matrix with the current file name, and if so overwrite it:
    strSearch = Left(wb1.Name, 8)
    Set rngSearch = ws2.Range("Y:Y")

    If Application.CountIf(rngSearch, strSearch) > 0 Then
        rowNum = Application.Match(strSearch, rngSearch, 0)
        With ws2
            Set EmptyRow = .Cells(rowNum, 1)
                For i = LBound(Data) To 24
                    EmptyRow.Offset(0, i - 1).Value = Application.Index(Data, i)
                Next i
            ws2.Hyperlinks.Add EmptyRow.Offset(0, 24), wb1.FullName, , "Click to go to IML file.", Data(25)

        End With

     'If the file name isn't already in IM Matrix, then enter data in new row:
     Else
        With ws2
            Set EmptyRow = .Cells(.Rows.Count, 1).End(xlUp).Offset(1)
                For i = LBound(Data) To 24
                    EmptyRow.Offset(0, i - 1).Value = Application.Index(Data, i)
                Next i                        
            ws2.Hyperlinks.Add EmptyRow.Offset(0, 24), wb1.FullName, , "Click to go to IML file.", Data(25)

        End With
    End If

     'Close & save IM Matrix file:
     wb2.Close SaveChanges:=True


End Sub

Based on the code that I got when I recorded creating a hyperlink seems like you need to just remove everything before ws2.Hyperlinks... . The hyperlink creation code contains the cell to put the link in, so I think it inherently fills the .Value for the cell.

Make sure to update the code in that covers the case that Application.CountIf(rngSearch, strSearch) > 0 returns as True since it's the trying to do the same thing.

You could also drop the For loop around adding the hyperlink since you're not really looping. You can either just increment i before the hyperlink creation, or just hardcode the values.

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM