Stuck with VBA Code. Creating a unique reference number with each macro click

**blackburnsexcel** · 11-27-2014, 08:19 AM

Hi,

I have an export to Word macro. I want to achieve more with is but my skills are limited so if you could help I'd be forever grateful.

The code is below.

Private Sub Quote_Click()
Dim WdObj As Object, fname As String
fname = Sheets(2).[a1].Value
Set WdObj = CreateObject("Word.Application")
WdObj.Visible = False
Selection.Copy 'Your Copy Range
WdObj.documents.Add
WdObj.Selection.PasteSpecial Link:=False, _
    DataType:=wdPasteText, Placement:= _
    wdInLine, DisplayAsIcon:=False
Application.CutCopyMode = False
If fname <> "" Then 'make sure fname is not blank
With WdObj
    .ChangeFileOpenDirectory "F:\Aacommon\Joe Signs\Quotes" 'save Dir
    .ActiveDocument.SaveAs Filename:=fname & ".doc"
End With
Else:
MsgBox ("File not saved, naming range was botched, guess again.")
End If
With WdObj
    .ActiveDocument.Close
    .Quit
End With
Set WdObj = Nothing
End Sub

What I would like to achieve is a unique reference number (URN) generated each time the macro button is clicked, that number entered in a specified cell within the sheet and then the file saved as that reference number.

Can anyone help me achieve that?

Also, how would I specify what needs to be exported? For example, I currently have to select the area I want to export and then click the button. I need it to export columns A to J and Rows 1 to 50.

Thanks in advance.

Edit: Apologies for not complying with the rules.

**Pepe Le Mokko** · 11-27-2014, 08:44 AM

Tags added

**Pepe Le Mokko** · 11-27-2014, 08:44 AM

Title much more clear

**blackburnsexcel** · 11-27-2014, 09:02 AM

I've found another piece of code that may acheive what I'm looking for but I wouldn't know how to integrate it.

Option Explicit 
 
Sub Increment() 
    Dim lNum As Long 
     
    lNum = Cells(1, 1).Value 'A1 change to suit
     'first check that a number is entered
    If Cells(1, 1).Value = "" Then 
        lNum = 1 
        Cells(1, 1).Value = lNum 
    Else: Cells(1, 1).Value = lNum + 1 
    End If 
End Sub