ipbr21054
Well-known Member
- Joined
- Nov 16, 2010
- Messages
- 5,715
- Office Version
- 2007
- Platform
- Windows
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.
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.
VBA Code:
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