dpaton05
Well-known Member
- Joined
- Aug 14, 2018
- Messages
- 2,392
- Office Version
- 365
- 2016
- Platform
- Windows
I have created spreadsheet that creates quotes successfully but my supervisor has asked me to add some sort of a reference so the quote can be identified.
I have code to add the name and I tried to edit it and add a bit to add the reference number but it wouldn't work. Could someone help me with the vba code please?
- There is a file client_list.xlsm that has the client name added too when the quote is finalised
- This code will be run from my quoting spreadsheet
- I also want a reference number to identify quotes
- When the quote is finalised, I want the reference number stored at the end of column A, in sheet "Reference", in the file client_list.xlsm to have a 1 added to it, and copied to the cell below it. I then want the new number to be put into H5 of my quoting spreadsheet, of the sheet NPSS_quote_sheet.
I have code to add the name and I tried to edit it and add a bit to add the reference number but it wouldn't work. Could someone help me with the vba code please?
Code:
Sub AddName()
Dim wb1 As Workbook, wb2 As Workbook
Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet
Dim f As Range, client As Variant, reference As Integer
Workbooks.Open fileName:=ThisWorkbook.Path & "\client_list.xlsm"
Set wb1 = ThisWorkbook
Set sh1 = wb1.Sheets("npss_quote_sheet")
Set wb2 = Workbooks("client_list.xlsm")
Set sh2 = wb2.Sheets("List")
Set sh3 = wb2.Sheets("Reference")
client = sh1.Range("G7")
Set f = sh2.Range("A:A").Find(client, , xlValues, xlWhole)
If f Is Nothing Then
sh2.Range("A" & Rows.Count).End(xlUp)(2) = client
End If
Range("A2", Range("A2").End(xlDown)).Sort Key1:=Range("A2"), Order1:=xlAscending, header:=xlNo
With sh3
.Range("A2").End(xlDown).Copy .Cells(1, 0).Paste
End With
reference = sh3.Range("A2").End(xlDown).Value + 1
With ActiveWorkbook
.Save
End With
End Sub