Templates

paulsolar · Aug 21, 2013

Hi All

I'm new to forums, so I'll give it a go

I've written a workbook for one section of PAS 2030 for my friends business to help him out. I can get everything working but am now stuck. I'm not bad with excel as I've been using it for 20 years or so to run small jobs.

Basically would like to do is have a job template that has a macro to:

increment the job numbers (done this before and had it working loads of times)
clear out the name and address cells each time the number is increased (done this before and had it working loads of times)
save the completed spread sheet to a folder on the desk top (never done this before!)
the completed sheet needs to be locked for auditing purposes (never done this before!)

Anyway I managed to a Mr Excel pod cast that showed some of this but I haven't managed to get it working

could someone out there stop from going bald please as I'm pulling my hair out. i look at some of the Macros and my mind boggles!

I've been trying the macro below but for some reason it will not work and keeps coming up with an error. This macro doesn't even cover the locking of the file when it's save I know, so if someone could help with that I'd be eternally grateful

Sub nextjob()
Range("g26").Value = Range("g26").Value + 1
Range("g6:g10").ClearContents
End Sub

Sub SaveNextJobWithNewName()
Dim NewFN As Variant
'Copy Job to new workbook
ActiveSheet.Copy
NewFN = "c:\desktop\Job Folder\Job" & Range("g26").Value & ".xlsx"
ActiveWorkbook.SaveAs NewFN, FileFormat:=xlOpenXMLWorkbook
ActiveWorkbook.Close
nextjob
End Sub

Many thanks in anticipation

Cheers

Paul

sijpie · Aug 23, 2013

Why don't you Save-As immediately instead of copying to a new file first?

You start from your template (which you don't want to change i assume) and then fill out the stuff, then do a save-as under the new name and close. No need to create new file and copy sheet.

What do you mean with locking the file for audits:

do you want to lock the file for access, so it can only be opened with password, or
do you want to protect the sheet against changes?

paulsolar · Aug 24, 2013

Hi Sijpie

Let me explain the process I'm using so you understand what I'm trying to achieve.

Basically I have a work book that books in a job. Every job has to have a unique reference number for auditing purposes to comply with government legislation, this number is assigned to cell G26. There are also fields for the name and address cells G6 to G10.

The work book for booking the jobs is actually 10 pages long when it is printed as it contains a lot of other information, the other information is generic and just copies the customers name and address into other cells, so when the cells G6 to G10 are cleared they clear the info from the generic parts of the rest of the work book. This all works fine.

I've locked the whole of the work book except cells that contain information which is specific to each job. This works fine.

The intention is that the operator just fills in the name and address and a few other bits from drop down boxes (by the was I've never managed to get clear contents to work for a cell with a drop down in it and I'm not sure if it is possible) , when this is done the operator just presses a macro "save button" which clears the content ready for the next job and increments the job number by 1 to avoid confusion or any replication of number and the work book is save to a folderf on the desk top, the file that is saved to the desk top should really be uneditable to avoid anyone tampering with it in the future (this is the part that an inspector can audit whenever they want).

The file is saved in the folder with the job reference number say "Job1" this can be altered in the code by using a different prefix in the line "NewFN = "c:\desktop\Job Folder\Job" & Range("g26").Value & ".xlsx" which I understand.

finally here is the bit that I don't understand and I'm not sure if it is even possible

I the folder on the desktop that each individual workbook is being saved to I'd like to have a separate spread sheet that keeps a record of the address that goes with each job number.

The idea i have is that every time a job is saved it creates an additional line in another spread sheet called "Cross Ref" in the job folder that stores the address against job numbers for easy look up.

Hope that explains what I'm up to

Cheers

Paul

sijpie · Aug 29, 2013

... (by the was I've never managed to get clear contents to work for a cell with a drop down in it and I'm not sure if it is possible) ...

Is the dropdown from a validation list? That works fine with my little test:

Code:

Sub tt()
   ' Cell L3 has validation list
    Cells(3, 11).ClearContents
End Sub

Check your setup of the validation list to see if blanks are allowed (ignore blanks)

paulsolar · Aug 29, 2013

Hi Sijpie

that little trick worked a treat

Cheers

Paul

sijpie · Aug 29, 2013

This will save the current sheet to a new workbook, convert formulas to values, lock all cells and password protect the sheet with random password.

Sub SaveNextJobWithNewName() Dim sPW As String Dim iArr(1 To 10) As Integer, i As Integer Dim NewFN As String ' set file name for job NewFN = "c:\desktop\Job Folder\Job" & Range("g26").Value & ".xlsx" ' fill password string with 10 random chars > 20 (exclude problem chars) For i = 1 To 10 sPW = sPW & Chr(CLng(Rnd(Time) * 200 + 20)) Next i 'copy job sheet to new workbook ActiveSheet.Copy With ActiveSheet With .UsedRange ' transform formulas to values .Value = .Value ' set cells to locked .Locked = True End With ' protect with random password .Protect sPW End With ActiveWorkbook.SaveAs NewFN, FileFormat:=xlOpenXMLWorkbook ActiveWorkbook.Close MsgBox "Job" & Range("g26").Value & ".xlsx saved" 'clear form for next job nextjob End Sub

paulsolar · Aug 29, 2013

Hi Sijpie

Many thanks for the latest gem.

Below is as far as I've got so far. I've just added you code for clearing content from cells with drop down boxes and that seems to be working fine, but I'm now stuck. I cant get the code that copies the data to a "Register of jobs" to work. I'd like to fix that problem before I add the code you just sent me. Can you see where I've gone wrong please?

Sub transfertoregister()
Dim Jobnumber As String
Dim jobdate As String
Dim name As String
Dim addressline1 As String
Dim addressline2 As String
Dim addressline3 As String
Dim postcode As String
Dim nameofengineer As String
Dim mydata As Workbook

Worksheets("Entry Sheet").Select
Jobnumber = Range("g26")
Worksheets("Entry Sheet").Select
jobdate = Range("g18")
Worksheets("Entry Sheet").Select
name = Range("G6")
Worksheets("Entry Sheet").Select
addressline1 = Range("G7")
Worksheets("Entry Sheet").Select
addressline2 = Range("G8")
Worksheets("Entry Sheet").Select
addressline3 = Range("G9")
Worksheets("Entry Sheet").Select
postcode = Range("G10")
Worksheets("Entry Sheet").Select
nameofengineer = Range("g20")

Set mydata = Workbooks.Open("C:\Users\Paul Breen\Desktop\Register of jobs.xlsx")

Worksheets("sheet1").Select
Worksheets("sheet1").Range("A1").Select
RowCount = Worksheets("sheet1").Range("A1").CurrentRegion.Rows.Count
With Worksheets("sheet1").Range("A2")
.Offset(RowCount, 0) = Jobnumber
.Offset(RowCount, 1) = jobdate
.Offset(RowCount, 2) = name
.Offset(RowCount, 3) = addressline1
.Offset(RowCount, 4) = addressline2
.Offset(RowCount, 5) = addressline3
.Offset(RowCount, 6) = postcode
.Offset(RowCount, 7) = nameofengineer
End With
mydata.Save

End Sub
Sub nextjob()
Range("g26").Value = Range("g26").Value + 1
Range("g6:g11").ClearContents
Range("g19:g20").ClearContents
Range("g24").ClearContents
Range("g31:g43").ClearContents
' Cell g13:g17 has validation list
Range("G13:G17").ClearContents

End Sub

Sub SaveNextJobWithNewName()
Dim NewFN As Variant
'Copy Job to new workbook
ActiveSheet.Copy
NewFN = "c:\users\Paul Breen\Desktop\Dry House\Dry House Job Management & Records\Job Numbers\Job No " & Range("g26").Value & ".xlsx"
ActiveWorkbook.SaveAs NewFN, FileFormat:=xlOpenXMLWorkbook
ActiveWorkbook.Close
nextjob
End Sub

sijpie · Aug 29, 2013

I need to look at it tomorrow. Two questions:
1. Why are you using your old SaveNextJobWithNewName sub instead of the new one?
2. Can you post code in code tags (see my tagline on how to do it) please. It is very difficult to read otherwise, which means i have to transfer it into VBA Editor, then do all the indenting before i can make sense of it. A lot of folks refuse to answer posts like yours.

paulsolar · Aug 29, 2013

Hi Sijpie

Many thanks for your assistance, I'm very new to all this coding.

I haven't incorporated your save next job as i was trying to figure out how it works so that i have a better understanding for the future. Your code for clearing content of cells with drop downs i could how that worked and could be incorporated immediately.

here goes at posting the code in the correct format

Code:

Code:

Sub transfertoregister()
Dim Jobnumber As String
Dim jobdate As String
Dim name As String
Dim addressline1 As String
Dim addressline2 As String
Dim addressline3 As String
Dim postcode As String
Dim nameofengineer As String
Dim mydata As Workbook




Worksheets("Entry Sheet").Select
Jobnumber = Range("g26")
Worksheets("Entry Sheet").Select
jobdate = Range("g18")
Worksheets("Entry Sheet").Select
name = Range("G6")
Worksheets("Entry Sheet").Select
addressline1 = Range("G7")
Worksheets("Entry Sheet").Select
addressline2 = Range("G8")
Worksheets("Entry Sheet").Select
addressline3 = Range("G9")
Worksheets("Entry Sheet").Select
postcode = Range("G10")
Worksheets("Entry Sheet").Select
nameofengineer = Range("g20")


Set mydata = Workbooks.Open("C:\Users\Paul Breen\Desktop\Register of jobs.xlsx")




Worksheets("sheet1").Select
Worksheets("sheet1").Range("A1").Select
RowCount = Worksheets("sheet1").Range("A1").CurrentRegion.Rows.Count
With Worksheets("sheet1").Range("A1")
.Offset(RowCount, 0) = Jobnumber
.Offset(RowCount, 1) = jobdate
.Offset(RowCount, 2) = name
.Offset(RowCount, 3) = addressline1
.Offset(RowCount, 4) = addressline2
.Offset(RowCount, 5) = addressline3
.Offset(RowCount, 6) = postcode
.Offset(RowCount, 7) = nameofengineer
End With
mydata.Save


End Sub
Sub nextjob()
Range("g26").Value = Range("g26").Value + 1
Range("g6:g11").ClearContents
Range("g19:g20").ClearContents
Range("g24").ClearContents
Range("g31:g43").ClearContents
   ' Cell g13:g17 has validation list
    Range("G13:G17").ClearContents
    
End Sub




Sub SaveNextJobWithNewName()
Dim NewFN As Variant
'Copy Job to new workbook
ActiveSheet.Copy
NewFN = "c:\users\Paul Breen\Desktop\Dry House\Dry House Job Management & Records\Job Numbers\Job No " & Range("g26").Value & ".xlsx"
ActiveWorkbook.SaveAs NewFN, FileFormat:=xlOpenXMLWorkbook
ActiveWorkbook.Close
nextjob


End Sub

I hope this helps

Kind regards

Paul

sijpie · Aug 30, 2013

Paul,

here is the complete package. Read through the comments to see what it does.

Option Explicit Const sJobFilePATH = "c:\desktop\Job Folder\Job" Const RegFilePATH = "C:\Users\Paul Breen\Desktop\" '---------------------------------------------- Sub TransfertoRegister() ' ' Sub to transfer job details to register file '---------------------------------------------- Dim sJobnumber As String, sJobdate As String, sName As String, _ sAddressline1 As String, sAddressline2 As String, _ sAddressline3 As String, sPostcode As String, _ sNameofEngineer As String Dim wbMyData As Workbook Dim wsOut As Worksheet Dim bCloseFlag As Boolean Const sRegFileNAME = "Register of jobs.xlsx" With Worksheets("Entry Sheet") sJobnumber = .Range("g26") sJobdate = .Range("g18") sName = .Range("G6") sAddressline1 = .Range("G7") sAddressline2 = .Range("G8") sAddressline3 = .Range("G9") sPostcode = .Range("G10") sNameofEngineer = .Range("g20") End With ' Check if Registry file is open On Error Resume Next Set wbMyData = Workbooks(sRegFileNAME) On Error GoTo 0 If wbMyData Is Nothing Then ' file is not open yet ' open file and set flag to remember to close again Set wbMyData = Workbooks.Open(RegFilePATH & sRegFileNAME) bCloseFlag = True End If Set wsOut = mydata.Sheets("sheet1") ' transfer details to Job Registry file, add to end With wsOut.Range("A1") RowCount = .CurrentRegion.Rows.Count + 1 .Offset(RowCount, 0) = sJobnumber .Offset(RowCount, 1) = sJobdate .Offset(RowCount, 2) = sName .Offset(RowCount, 3) = sAddressline1 .Offset(RowCount, 4) = sAddressline2 .Offset(RowCount, 5) = sAddressline3 .Offset(RowCount, 6) = sPostcode .Offset(RowCount, 7) = sNameofEngineer End With ' add hyperlink to the jobfile for easy access With wsOut .Hyperlinks.Add anchor:=.Offset(RowCount, 0), _ Address:=sJobFilePATH & "Job" & _ .Offset(RowCount, 0).Value & ".xlsx" End With ' save registry and close if it wasn't already open If bCloseFlag Then wbMyData.Close savechanges:=True Else wbMyData.Save End If 'clean up Set wbMyData = Nothing Set wsOut = Nothing End Sub '---------------------------------------------- Sub NextJob() ' ' Macro to clear form, ready for next entry '---------------------------------------------- Range("g26").Value = Range("g26").Value + 1 Range("g6:g11").ClearContents Range("g19:g20").ClearContents Range("g24").ClearContents Range("g31:g43").ClearContents ' Cell g13:g17 has validation list Range("G13:G17").ClearContents End Sub '---------------------------------------------- Sub SaveNextJobWithNewName() ' ' macro to save entry form to new file for _ archiving. Sheet is password protected _ with random password to protect against _ changes '---------------------------------------------- Dim sPW As String Dim iArr(1 To 10) As Integer, i As Integer Dim NewFN As String ' set file name for job NewFN = sJobFilePATH & Range("g26").Value & ".xlsx" ' fill password string with 10 random chars > 20 (exclude problem chars) For i = 1 To 10 sPW = sPW & Chr(CLng(Rnd(Time) * 200 + 20)) Next i 'copy job sheet to new workbook ActiveSheet.Copy With ActiveSheet With .UsedRange ' transform formulas to values .Value = .Value ' set cells to locked .Locked = True End With ' protect with random password .Protect sPW End With ActiveWorkbook.SaveAs NewFN, FileFormat:=xlOpenXMLWorkbook ActiveWorkbook.Close 'transfer data to register TransfertoRegister MsgBox "Job" & Range("g26").Value & ".xlsx registered & saved" 'clear form for next job NextJob End Sub

Templates

paulsolar

Well-known Member

Excel Facts

sijpie

Well-known Member

paulsolar

Well-known Member

sijpie

Well-known Member

paulsolar

Well-known Member

sijpie

Well-known Member

paulsolar

Well-known Member

sijpie

Well-known Member

paulsolar

Well-known Member

sijpie

Well-known Member

Similar threads

Forum statistics

Share this page

Templates

Well-known Member

Excel Facts

Well-known Member

Well-known Member

Well-known Member

Well-known Member

Well-known Member

Well-known Member

Well-known Member

Well-known Member

Well-known Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock