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]

Here is an example of selecting the wrong customer & IAN SMALLMAN 028 should of been selected
But i see no code ton find / match value from cell B3

 

[ipbr21054]

In the partial piece of code below i assume the part that should look for the value in column B in shown in Red ?

Done a few tests & changing the customers name in cell B3 then looking for a match in column B it will only select the last cell in column B as opposed the customers name,which was the value in cell B3

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

 

[NoSparks]

Your POSTAGE sheet _Activate event selects that last customer.
Your DiscoIIHyperlink _Initialize has TestBox1.ControlSource = ActiveCell.Address

I'm guessing this line is never true

    If C.Value = ans Then

or the Application.Goto line would be selecting the C cell

for test purposes comment out Application.ScreenUpdating = False
and add the bold message box and stop instruction

       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
        
        MsgBox ActiveWorkbook.Name & vbCrLf & ActiveCell.Parent.Name & vbCrLf & _
               ActiveCell.Address & vbCrLf & ActiveCell.Value2 & vbCrLf & vbCrLf & ans
        
        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
        Stop
        Application.Goto Reference:=wb.Sheets("POSTAGE").Range(C.Address)
        ActiveWindow.ScrollColumn = 1
    Exit For
    End If
    
    Next

    End With

show us a picture of the msgbox result and tell us if the code ever stops at the stop instruction

 

[ipbr21054]

Just got in so looking now.
In the mean time i removed the following from the POSTAGE sheet & the finds the correct customer fine.
Just the scroll out of sync etc now

Private Sub Worksheet_Activate()
' scroll sheet to have specified cell selected and at top left
Application.Goto Sheets("POSTAGE").Range("B" & Rows.count).End(xlUp).Offset(0, -1), True
' offset from that specified cell to select desired cell
ActiveCell.Offset(, 1).Select
' scroll sheet to position row in view
ActiveWindow.SmallScroll UP:=14
End Sub

 

[ipbr21054]

Attached is the msgbox

In my drop down i have Z TEST 001 002 & 003
I select Z TEST 002.
The code runs & the Msgbox shown above pops up.
All the time the Msgbox is present i see an egg time.
I wait a while but still the same.
I select OK to the Msgbox & the code continues to run.
Workbook DR opens.
POSTAGE sheet is selected.
The code then selects Z TEST 003

So i say NO it doenst stop

 

[NoSparks]

step through the code with the F8 key and tell me which line is selecting Z TEST 003

 

[ipbr21054]

I am unable too as when i get to the following i sit there pressing F8 forever

Private Sub TextBox7_Change()
    TextBox7 = UCase(TextBox7)
   For i = 1 To 600
DoEvents
Sleep (10) ' THIS DELAY ALLOWS THE USER TO SELECT THE REMOTE TYPE
Next i
Call DISCOCODE
End Sub

 

[ipbr21054]

Maybe approach it another way so we dont have to open the DR sheet & blah blah blah
We allready populate a combobox with the POSTAGE sheet names so now its a matter of applying a hyperlink.

I did the B3 way as i couldnt figure the next part out

 

[ipbr21054]

In my code this userform gets populated with the names.
So as opposed to going all down that path fixing it can we hyperlink here somehow as we already have the names ?

This is why i put the name in B3 as i couldnt work out who to proceed in what ive kust asked.