I have been searching the web & forums but cannot find the solution I need.
I have a template that is used for a calibration. We need to generate an automatic number to be used on the certificate, when the calibration is logged and certificate generated by office staff.
All the calibrations are logged on a ledger file but the existing certificate numbers are prefixed with the operator initials and in some cases suffixed with an A. They are not necessarily in number order either. If a calibration is amended it is logged a second time, using the existing certificate number with the A suffix.
I had envisaged adding a separate sheet ("Cert_Numbers") to the ledger file Sieve_Ledger_Latest.xls, with 3 columns Number - Date - Identifier.
When the calibration is logged, firstly we need to check whether there is already a number. If there is no number within named range "Certificate_Number" I would like to add code to generate the numerical part of the certificate number by taking the next number in sequence from the Number column and save it to named range "Certificate_Number" within my file.
I would like to save the current date and identifier (from named range "caldata11") next to the number on the "Cert_Numbers" sheet.
Number | Date | Identifier |
10000 | 18/01/2021 | 0456984/501087_26269 |
10001 | 19/01/2021 | 733510/501994_26269 |
Then my existing code would log the calibration on the ledger.
This is the code I have for logging the calibration.
Sub logsievecalibration()
'
Dim ThisWorkBook As String
Dim SheetName As String
Dim MyRanges(13) As Variant ' changed from string to remove issue with UK/US dates on ledger
Dim EmptyRow As Long
Dim a As Integer 'to cyle through ranges
' Unprotect sheet to allow macro to function
Call UnProtectSheets
Worksheets("Sieve Details & Results").Activate
ThisWorkBook = ActiveWorkbook.Name
SheetName = ActiveSheet.Name
'Named Ranges with sheets specified as from more than one sheet
MyRanges(1) = "caldata1" 'Certificate Type - col B
MyRanges(2) = "caldata2" 'Certificate Number - col C
MyRanges(3) = "caldata3" 'Calibration Date - col D
MyRanges(4) = "caldata4" 'Customer Account Number - col D
MyRanges(5) = "caldata5" 'Customer Name - col E
MyRanges(6) = "caldata6" 'Col5 from Opera records should be Town - col F
MyRanges(7) = "caldata7" 'Postcode column from Opera records should be Postcode - col G
MyRanges(8) = "caldata8" 'Standard - col H
MyRanges(9) = "caldata9" 'Diameter - col I
MyRanges(10) = "caldata10" 'Aperture - col K
MyRanges(11) = "caldata11" 'Unique Identifier - col L
MyRanges(12) = "caldata12" 'Email Address - col L
MyRanges(13) = "caldata13" 'Job Number - col M
' Assign values from range names to array
MyRanges(1) = Range("caldata1").Value
MyRanges(2) = Range("caldata2").Value2
MyRanges(3) = Range("caldata3").Value
MyRanges(4) = Range("caldata4").Value
MyRanges(5) = Range("caldata5").Value
MyRanges(6) = Range("caldata6").Value
MyRanges(7) = Range("caldata7").Value
MyRanges(8) = Range("caldata8").Value
MyRanges(9) = Range("caldata9").Value
MyRanges(10) = Range("caldata10").Value
MyRanges(11) = Range("caldata11").Value
MyRanges(12) = Range("caldata12").Value
MyRanges(13) = Range("caldata13").Value
Workbooks.Open filename:= _
"S:\Calibrations\Ledgers\Sieve_Ledger_Latest.xls"
Workbooks("Sieve_Ledger_Latest.xls").Activate
With Workbooks("Sieve_Ledger_Latest.xls")
.Sheets("Calibrations").Activate
With ActiveSheet
'find empty row
EmptyRow = 0
Do
EmptyRow = EmptyRow + 1
Loop Until IsEmpty(.Cells(EmptyRow, 1))
.Cells(EmptyRow, 1) = Date
'fill in other columns from named ranges
For a = 1 To UBound(MyRanges)
.Cells(EmptyRow, a + 1) = MyRanges(a)
Next a
End With
'save and close workbook
.Save
.Close
End With
'activate back to where you started
Workbooks(ThisWorkBook).Activate
Worksheets("Sieve Details & Results").Activate
'Change Log Button Colour to indicate calibration has been entered on the ledger
ActiveSheet.Shapes.Range(Array("log button")).Select
With Selection.ShapeRange.Fill
.ForeColor.RGB = RGB(211, 211, 211)
End With
' Protect sheets again
Call ProtectSheets
Worksheets("Sieve Details & Results").Activate
End Sub
Display More
I know that the code is a bitt messy with selects and activates but I'm struggling with those too.
I would be grateful for any advice with this as I leave my job in 2 weeks and would like to see this finished. Thank you in advance,.