Templates

[paulsolar]

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

 

[paulsolar]

Hi Sijpie

I cant thank you enough for looking at this for me.

I just need a little more assistance. I can see what each section is doing with your annotation which is a tremendous help.

Just for clarification and to ensure that I have all the file paths correct.

The main job entry sheet is: C:\Users\Paul Breen\Desktop\Dry House\Dry House Job Management & Records\Job Entry Workbook.xlsm
The Folder where the jobs are stored is: C:\Users\Paul Breen\Desktop\Dry House\Dry House Job Management & Records\Job Numbers
The register where the job numbers are stored with the address' is: C:\Users\Paul Breen\Desktop\Dry House\Dry House Job Management & Records\Job Numbers\Job Register.xlsx

If I insert these into the code where i think they belong and send it back for you to check would you be kind enough to look at it for me please.

Once again thanks for all your help, by looking at what you have done it's opened my eyes to how this code works and what it is capable of doing

kind regards

Paul

 

[sijpie]

Look at the top, this is where you should put the paths ( in th constants) ending with \
and the file name of the registry file should be in the transfer sub, withou the path.

Just try it with a dummy and see if it works.

also, read my guide to better VBA ( see link below) on how to step through the code and check what is happening

 

[paulsolar]

Hi Sijpie

I'm having a spot of bother

this is how I've altered it
Code:

Option Explicit





Const sJobFilePATH = " C:\Users\Paul Breen\Desktop\Dry House\Dry House Job Management & Records\Job Numbers"
Const RegFilePATH = "C:\Users\Paul Breen\Desktop\Dry House\Dry House Job Management & Records\Job Numbers\Job Register.xlsx"


'----------------------------------------------
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 = "C:\Users\Paul Breen\Desktop\Dry House\Dry House Job Management & Records\Job Numbers\Job Register.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

when I use the macro I get run time error 1004: File could not be accessed, try one of the following................................................

I noticed that the macro is creating a new workbook which it's assigning as Book 1 but it stops before it goes any further and the code line

ActiveWorkbook.SaveAs NewFN, FileFormat:=xlOpenXMLWorkbook is highlighted in the dubugger (this is almost at the end of the code)

I've obviously gone wrong somewhere, could you point out my mistake to me please

Kind regards

Paul

 

[Mindpsyche]

Hi,

I just read the other thread that was closed and referred this so I am responding in this thread what I think is the problem.

This is the original code i think.

With Range("A1")
        RowCount = .CurrentRegion.Range("A1").Rows.Count + 1
        .Offset(RowCount, 0) = sJobnumber
 End With

And this is your code: You have used the Rowcount variable which has not been previously assigned. Moreover you are using it as a property / method of the range A1 which is not possible. Use the code above, I think it should work.

With Range("A1")
        .RowCount = .CurrentRegion.Range("A1").Rows.Count + 1
        .Offset(RowCount, 0) = sJobnumber
    End With

Try:

Dim RowCount as long
RowCount = .CurrentRegion.Range("A1").Rows.Count + 1 

'instead of 

.RowCount = .CurrentRegion.Range("A1").Rows.Count + 1

 

[paulsolar]

Hi All

I'm pulling my hair out with frustration

I've been working through debugging the code written for me by Sijpie, I've managed to sort out some of his code to fit my requirements, but the bit of code below has been frying my brain for hours. I cant find the answer anywhere. I've read everything I can and have tried everything I can think of. I keep getting the error message "variable not defined"

the piece of code that is highlighted in blue is ".Offset(RowCount, 0) = sJobnumber"

Code:

[/COLOR]Option Explicit





Const sJobFilePATH = "C:\Desktop\Dry House\Dry House Job Management & Records\Job Numbers\"
Const RegFilePATH = "C:\Users\Paul Breen\Desktop\Dry House\Dry House Job Management & Records\Job Numbers\"


'----------------------------------------------
Sub TransfertoRegister()
'
' Sub to transfer job details to register file
'----------------------------------------------
    Dim sJobnumber As String
    Dim sJobdate As String
    Dim sName As String
    Dim sAddressline1 As String
    Dim sAddressline2 As String
    Dim sAddressline3 As String
    Dim sPostcode As String
    Dim sNameofEngineer As String
    Dim wbMyData As Workbook
    Dim wsOut As Worksheet
    Dim bCloseFlag As Boolean
    Const sRegFileNAME = "C:\Users\Paul Breen\Desktop\Dry House\Dry House Job Management & Records\Job Numbers\Job Register.xlsx"








    With Worksheets("Sheet 1")
        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("C:\Users\Paul Breen\Desktop\Dry House\Dry House Job Management & Records\Job Numbers\Job Register.xlsx")
    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 = wbMyData.Worksheet("Sheet1")
    ' transfer details to Job Registry file, add to end


    
    With wsOut.Range("A1")
        .RowCount = .CurrentRegion.Range("A1").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[COLOR=#333333]

can you let me know where I'm going wrong please?

thanks in anticipation

kind regards

Paul

 

[Mindpsyche]

Check my post above please, it might be the reason.

 

[paulsolar]

Hi Mindpsyche

Many thanks for your help.

I used your code "Dim RowCount as long" and that worked, but now I've got another error

"Compile error:
Method or data member not found"

it appears that the error is in the code below

With wsOut
.Hyperlinks.Add anchor:=.Offset(RowCount, 0), _
Address:=sJobFilePATH & "Job" & _
.Offset(RowCount, 0).Value & ".xlsx"

the offset (in blue for clarity) is being highlighted in blue

any ideas?

regards

Paul

 

[Mindpsyche]

Hi Mindpsyche

Many thanks for your help.

I used your code "Dim RowCount as long" and that worked, but now I've got another error

"Compile error:
Method or data member not found"

it appears that the error is in the code below

With wsOut
.Hyperlinks.Add anchor:=.Offset(RowCount, 0), _
Address:=sJobFilePATH & "Job" & _
.Offset(RowCount, 0).Value & ".xlsx"

the offset (in blue for clarity) is being highlighted in blue

any ideas?

regards

Paul

Again, the .Offset used cannot be used with a worksheet which is wsOut. You are setting an Offset to a Worksheet hence why it isnt working. Why don't you just assign the Range of the cell instead of the .Offset(Rowcount, 0) try using Range("A"&rowcount)

I don't know much about hyperlinks in vba but check out this example on MSDN which would help you understand what I am talking about. Notice, how a range is being used instead of the .Offset property. I believe your column being used is A so I think
.Range("A" & Rowcount), _ should work.

With Worksheets(1)  .Hyperlinks.Add Anchor:=.Range("a5"), _  Address:="http://example.microsoft.com", _  ScreenTip:="Microsoft Web Site", _  TextToDisplay:="Microsoft" End With</pre>

 

[paulsolar]

Hi Mindpsyche

Many thanks again for your help.

The problem has now moved on thanks to your assistance and I found an error which has progressed things as well

Now when I activate the macro we have a new problem! It opens up the register work book on sheet1 which is where i want the info to be copied to, but i now get the error

message 438: object doesn't support this property or method

I changed the code to the below

[/COLOR]Option Explicit





Const sJobFilePATH = "C:\Desktop\Dry House\Dry House Job Management & Records\Job Numbers\"
Const RegFilePATH = "C:\Users\Paul Breen\Desktop\Dry House\Dry House Job Management & Records\Job Numbers\"


'----------------------------------------------
Sub TransfertoRegister()
'
' Sub to transfer job details to register file
'----------------------------------------------
    Dim sJobnumber As String
    Dim sJobdate As String
    Dim sName As String
    Dim sAddressline1 As String
    Dim sAddressline2 As String
    Dim sAddressline3 As String
    Dim sPostcode As String
    Dim sNameofEngineer As String
    Dim wbMyData As Workbook
    Dim wsOut As Worksheet
    Dim bCloseFlag As Boolean
    Const sRegFileNAME = "C:\Users\Paul Breen\Desktop\Dry House\Dry House Job Management & Records\Job Numbers\Job Register.xlsx"








    With Worksheets("Sheet 1")
        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("C:\Users\Paul Breen\Desktop\Dry House\Dry House Job Management & Records\Job Numbers\Job Register.xlsx")
    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(sRegFileNAME)
        bCloseFlag = True
    End If
    
    Set wsOut = wbMyData.Worksheet("Sheet 1")
    ' transfer details to Job Registry file, add to end


    
    With wsOut.Range("A1")
    Dim RowCount As Long
RowCount = .CurrentRegion.Range("A1").Rows.Count + 1
Range("A" & RowCount, 0) = sJobnumber
Range("A" & RowCount, 1) = sJobdate
Range("A" & RowCount, 2) = sName
Range("A" & RowCount, 3) = sAddressline1
Range("A" & RowCount, 4) = sAddressline2
Range("A" & RowCount, 5) = sAddressline3
Range("A" & RowCount, 6) = sPostcode
Range("A" & RowCount, 7) = sNameofEngineer




    End With
    ' add hyperlink to the jobfile for easy access
    With wsOut
    .Hyperlinks.Add Anchor:=.Range("A1" & RowCount), _
                Address:=sJobFilePATH & "Job" & _
                .Range("A1" & RowCount).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

Now I'm really struggling

Cheers

Paul

 

[Mindpsyche]

Any time you have an error, you should show the line causing it.

Anyway, I think its because your referring to "Sheet1" as "Sheet 1"...there is a space between Sheet and 1. If you have not manually changed the name of the sheet to "Sheet 1" then this is causing the problem, i think. Its 3:30 a.m. here so I can't really look any further at this time.

If the error persists, please also paste the line thats causing it, and the error message.

Good luck.