Find customer in column & link to his pdf

[ipbr21054]

I have the following code in use.
Thought this was sorted but code doesnt find correct customer in column B.

I am in workbook DISCO CALC & on sheet PRINT LABELS
I run the code below where the user selects a customer from a userform drop down,this is populated from workbook called DR sheet postage
After the customer is selected his pdf is saved no problem & his name is entered in cell B3

Now the code opens workbook DR & selects sheet POSTAGE, so far all done is correct.
This is the issue.

The code is supposed to find the customer from cell B3 "on the previous sheet in this case TOM JONES" in column B of POSTAGE
Once found a userform will open where the user is asked to hyperlink the found customer.

The issue is that the code selects the last name in column B as ooposed to the customer TOM JONES.

Private Sub PurchasedKey_Click()
  Dim sPath As String
  Dim strFileName As String
  Dim sh As Worksheet
  Dim wb As Workbook
 
  With ActiveSheet
    If .Range("Q1") = "" Then
      MsgBox "NO CODE SHOWN TO GENERATE PDF", vbCritical, "NO CODE ON SHEET TO CREATE PDF"
      Exit Sub
    End If
    
    If .Range("N1") = "M" Then
       strFileName = "C:\Users\Ian\Desktop\REMOTES ETC\DISCO II CODE\DISCO II PDF\" & .Range("B3").Value & " (SLS).pdf"
    Else
       strFileName = "C:\Users\Ian\Desktop\REMOTES ETC\DISCO II CODE\DISCO II PDF\" & .Range("B3").Value & ".pdf"
    End If
          
    If Dir(strFileName) = "" Then
      .Range("A1:K23").ExportAsFixedFormat Type:=xlTypePDF, Filename:=strFileName, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False
       MsgBox "PDF FILE HAS NOW BEEN SAVED", vbInformation + vbOKOnly, "SAVED PDF FILE MESSAGE"
      
       With ActiveSheet
    'ActiveWindow.SelectedSheets.PrintOut copies:=1
    Unload PrinterForm
    
        .Range("B3").Select
        Application.ScreenUpdating = False
    Dim C As Range
    Dim ans As String
    Dim Lastrow As Long
        ans = ActiveCell.Value
        Set wb = Application.Workbooks.Open("C:\Users\Ian\Desktop\REMOTES ETC\DR\DR.xlsm")
        Lastrow = Sheets("POSTAGE").Cells(Rows.Count, "B").End(xlUp).Row
        
    For Each C In Sheets("POSTAGE").Range("B1:B" & Lastrow)
    If C.Value = ans Then
        Application.Goto Reference:=wb.Sheets("POSTAGE").Range(C.Address)
        ActiveWindow.ScrollColumn = 1
    Exit For
    End If
    
    Next

    End With
    
          Application.Run ("'" & wb.Name & "'!openForm")
          Application.ScreenUpdating = True
      
    Else
        'IF FILE IS PRESENT DO NOT ALLOW FILE TO BE OVERWRITTEN & TO SHOW MSGBOX
        MsgBox "CUSTOMERS FILE HAS ALLREADY BEEN SAVED", vbCritical + vbOKOnly, "FILE ALLREADY SAVED MESSAGE"
            
    Dim strFolder As String
        strFolder = "C:\Users\Ian\Desktop\REMOTES ETC\DISCO II CODE\DISCO II PDF\"
        ActiveWorkbook.FollowHyperlink Address:=strFolder, NewWindow:=True
        Unload PrinterForm
    End If
        
    Exit Sub
          End With
End Sub

 

[ipbr21054]

Just a thought.
As opposed to matching the customer then adding a hyperlink why not once the pdf has been saved etc open workbook DR, select sheet POSTAGE then with the code if customers name is present in column B & in given path / folder then apply hyperlink that customer.

The code should look last row then up the page in column B
Maybe only look in last 10 rows as this will be fine.

I think this is the easier way to fix it.

 

[NoSparks]

The issue is that whatever you are putting into workbook DISCO CALC sheet PRINT LABELS cell B3
doesn't exist in workbook DR sheet POSTAGE column B
or the STOP instruction that was added would be stopping the code execution at that point.

 

[ipbr21054]

But it does.
Look here at my work flow.

POSTAGE sheet customers details are added then saved to worksheet.

I then open DISCO CALC sheet.Combox is populated with last 6 / 7 names from column B on POSTAGE sheet.

Once im done there the name STEVE JONES 001 is placed in cell B3

Here is the saved pdf file for STEVE JONES 001

Here is my code put back to how it was.
So as a test can you edit please to do this, Lets forget the value in cell B3
When the POSTAGE sheet is open & column B is used the code will look for any customer that is in column B,last row & up say 10 rows that are also in this folder & if present hyperlink them.

Path to folder where pdf are kept.
C:\Users\Ian\Desktop\REMOTES ETC\DISCO II CODE\DISCO II PDF

Lets assume all but one have been hyperlinked before.The code looks at the names & can see that STEVE JONES 001 is in the folder where the pdf are kept so it the applies a hyperlink to STEVE JONES 001 in column B

So now when i click STEVE JONES 001 in column B the pdf for STEVE JONES 001 in the pdf folder opens.

Job done.

No need for B3 vakue anymore just have the code check names in column B against what is in the pdf folder & hyperlink if needed.

Private Sub PurchasedKey_Click()
  Dim sPath As String
  Dim strFileName As String
  Dim sh As Worksheet
  Dim wb As Workbook
 
    With ActiveSheet
    If .Range("Q1") = "" Then
      MsgBox "NO CODE SHOWN TO GENERATE PDF", vbCritical, "NO CODE ON SHEET TO CREATE PDF"
      Exit Sub
    End If
    
    If .Range("N1") = "M" Then
       strFileName = "C:\Users\Ian\Desktop\REMOTES ETC\DISCO II CODE\DISCO II PDF\" & .Range("B3").Value & " (SLS).pdf"
    Else
       strFileName = "C:\Users\Ian\Desktop\REMOTES ETC\DISCO II CODE\DISCO II PDF\" & .Range("B3").Value & ".pdf"
    End If
          
    If Dir(strFileName) = "" Then
      .Range("A1:K23").ExportAsFixedFormat Type:=xlTypePDF, Filename:=strFileName, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False
       MsgBox "PDF FILE HAS NOW BEEN SAVED", vbInformation + vbOKOnly, "SAVED PDF FILE MESSAGE"
      
    With ActiveSheet
    'ActiveWindow.SelectedSheets.PrintOut copies:=1
    Unload PrinterForm
    
        .Range("B3").Select
        Application.ScreenUpdating = False
    Dim C As Range
    Dim ans As String
    Dim Lastrow As Long
        ans = ActiveCell.Value
        
        
    Set wb = Application.Workbooks.Open("C:\Users\Ian\Desktop\REMOTES ETC\DR\DR.xlsm")
        Lastrow = Sheets("POSTAGE").Cells(Rows.Count, "B").End(xlUp).Row
        
        
    For Each C In Sheets("POSTAGE").Range("B1:B" & Lastrow)
    If C.Value = ans Then
        Application.Goto Reference:=wb.Sheets("POSTAGE").Range(C.Address)
        ActiveWindow.ScrollColumn = 1
    Exit For
    End If
    
    Next

    End With
    
          Application.Run ("'" & wb.Name & "'!openForm")
          Application.ScreenUpdating = True
      
    Else
        'IF FILE IS PRESENT DO NOT ALLOW FILE TO BE OVERWRITTEN & TO SHOW MSGBOX
        MsgBox "CUSTOMERS FILE HAS ALLREADY BEEN SAVED", vbCritical + vbOKOnly, "FILE ALLREADY SAVED MESSAGE"
            
    Dim strFolder As String
        strFolder = "C:\Users\Ian\Desktop\REMOTES ETC\DISCO II CODE\DISCO II PDF\"
        ActiveWorkbook.FollowHyperlink Address:=strFolder, NewWindow:=True
        Unload PrinterForm
    End If
        
    Exit Sub
          End With
End Sub

 

[ipbr21054]

This works for me but ned an edit please.
The edit being only check last 10 rows to hyperlink,no need for the code to check 2250 rows

Thanks for your help with this

Private Sub PurchasedKey_Click()
  Dim sPath As String
  Dim strFileName As String
  Dim sh As Worksheet
  Dim wb As Workbook
 
    With ActiveSheet
    If .Range("Q1") = "" Then
      MsgBox "NO CODE SHOWN TO GENERATE PDF", vbCritical, "NO CODE ON SHEET TO CREATE PDF"
      Exit Sub
    End If
    
    If .Range("N1") = "M" Then
       strFileName = "C:\Users\Ian\Desktop\REMOTES ETC\DISCO II CODE\DISCO II PDF\" & .Range("B3").Value & " (SLS).pdf"
    Else
       strFileName = "C:\Users\Ian\Desktop\REMOTES ETC\DISCO II CODE\DISCO II PDF\" & .Range("B3").Value & ".pdf"
    End If
          
    If Dir(strFileName) = "" Then
      .Range("A1:K23").ExportAsFixedFormat Type:=xlTypePDF, Filename:=strFileName, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False
       MsgBox "PDF FILE HAS NOW BEEN SAVED", vbInformation + vbOKOnly, "SAVED PDF FILE MESSAGE"
      
    With ActiveSheet
    'ActiveWindow.SelectedSheets.PrintOut copies:=1
    Unload PrinterForm
    
    Set wb = Application.Workbooks.Open("C:\Users\Ian\Desktop\REMOTES ETC\DR\DR.xlsm")
             Worksheets("POSTAGE").Activate
    
            Application.Goto Sheets("POSTAGE").Range("A" & Rows.Count).End(xlUp), True
            ActiveWindow.SmallScroll UP:=14
    
    End With
    End If
    End With
    
    Call DISCOHYPERLINK

End Sub

Call DISCOHYPERLINK code is as follows

Sub DISCOHYPERLINK()
    Const sPath As String = "C:\Users\Ian\Desktop\REMOTES ETC\DISCO II CODE\DISCO II PDF\"
  Dim sFile As String, i As Long
  With Sheets("POSTAGE")
    For i = 2 To .Range("B" & Rows.Count).End(3).Row
      sFile = sPath & .Range("B" & i).Value & ".pdf"
      If Len(Dir(sFile)) Then
        .Range("B" & i).Hyperlinks.Add Anchor:=.Range("B" & i), Address:=sFile
      End If
    Next
  End With
  MsgBox "CUSTOMER WAS HYPERLINKED.", vbInformation, "DISCO II HYPERLINK MESSAGE"
End Sub

 

[NoSparks]

Dim lastrow as Long  
With Sheets("POSTAGE")
    lastrow = .Range("B" & .Rows.Count).End(xlUp).Row
    For i = lastrow - 10 To lastrow

 

[ipbr21054]

Morning.

The code with the added code above is supplied but i am seeing i is not defined.
Please advise what i should change / add to the code.
Thanks

For future reference how do i know what im supposed anyway ?

Sub DISCOHYPERLINK()
  Dim lastrow As Long
  With Sheets("POSTAGE")
    lastrow = .Range("B" & .Rows.Count).End(xlUp).Row
    For i = lastrow - 10 To lastrow
    
    Const sPath As String = "C:\Users\Ian\Desktop\REMOTES ETC\DISCO II CODE\DISCO II PDF\"
  Dim sFile As String, i As Long
  With Sheets("POSTAGE")
    For i = 2 To .Range("B" & Rows.Count).End(3).Row
      sFile = sPath & .Range("B" & i).Value & ".pdf"
      If Len(Dir(sFile)) Then
        .Range("B" & i).Hyperlinks.Add Anchor:=.Range("B" & i), Address:=sFile
      End If
    Next
  End With
  MsgBox "CUSTOMER WAS HYPERLINKED.", vbInformation, "DISCO II HYPERLINK MESSAGE"
End Sub

 

[NoSparks]

Sub DISCOHYPERLINK()
    Const sPath As String = "C:\Users\Ian\Desktop\REMOTES ETC\DISCO II CODE\DISCO II PDF\"
  Dim sFile As String, i As Long
  
  Dim lastrow As Long
  With Sheets("POSTAGE")
    lastrow = .Range("B" & .Rows.Count).End(xlUp).Row
    For i = lastrow - 10 To lastrow
    
      sFile = sPath & .Range("B" & i).Value & ".pdf"
      If Len(Dir(sFile)) Then
        .Range("B" & i).Hyperlinks.Add Anchor:=.Range("B" & i), Address:=sFile
      End If
    Next
  End With
  MsgBox "CUSTOMER WAS HYPERLINKED.", vbInformation, "DISCO II HYPERLINK MESSAGE"
End Sub