Unique generated alphanumeric number

[gr8guy]

hi,

Atlast i made the coding which i wanted so badly!

here's it for everybody to improvise upon & mk it neat & tidy, short &
sweet!

Pls note: - on worksheet("Sheet1"),
in cells IU65536, i hv formated the cell as number & entered value 0
(starting value)
in cells IV65536, i hv formated the cell as text & entered value '00000
(starting value)

Q1) But i hv a problem, i.e. reg the saving printing & printing part!

If you go thru my code, you will see that each time i save the workbook, it
will create a new copy of it with the "SaveCopyAs" method, which will also
include the below code in every new workbook, thereby increasing it size &
giving way to manipulation by users who do a save as. What i want is,
whenever a user does a saveas or just clicks save icon, only the 1st
worksheet (its contents) should be saved (or copied) as a new workbook with
the UniqID name & it should not include the coding part. the code should not
be there or any other sheets, only sheet1.

i tried using Copy method of Activesheet, but it doesnot let me gv my own
autogenerated name thru coding.
pls note the foll codes not working!

'ActiveWorkbook.Worksheets("Sheet1").Copy "C:\Documents and
Settings\eijaz\Desktop\" & Worksheets("Sheet1").Cells(1, 1).Value & ".XLS"

'ActiveWorkbook.Worksheets("Sheet1").Copy Filename:= "C:\Documents and
Settings\eijaz\Desktop\" & Worksheets("Sheet1").Cells(1, 1).Value & ".XLS"

'ActiveWorkbook.Worksheets("Sheet1").SaveCopyAs "C:\Documents and
Settings\eijaz\Desktop\" & Worksheets("Sheet1").Cells(1, 1).Value & ".XLS"

Unique generated alphanumeric number
===========================

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As
Boolean)
On Error Resume Next
Dim strCurr As String
Dim lngCount As Long
Dim strPrev As String

'Assigning last cells to Variables
strCurr = Worksheets("Sheet1").Cells(65536, 256).Value
strPrev = strCurr
lngCount = Worksheets("Sheet1").Cells(65536, 255).Value

'Concatenating variables & assigning to 1st cell
Worksheets("Sheet1").Cells(1, 1).Value = "RV - " & strCurr & lngCount

'Incrementing lngCount
lngCount = lngCount + 1

UniqID lngCount, strCurr, strPrev

'Concatenating variables after increment & assigning to 1st cell
Worksheets("Sheet1").Cells(1, 1).Value = "RV - " & strCurr & lngCount

'Assigning variables to last cells
Worksheets("Sheet1").Cells(65536, 256).Value = strCurr
Worksheets("Sheet1").Cells(65536, 255).Value = lngCount

a = MsgBox("Do you really want to save the workbook?", vbYesNo)
If a = vbNo Then
Cancel = True

'Assigning variables to last cells with a decrement
Worksheets("Sheet1").Cells(65536, 256).Value = strPrev
Worksheets("Sheet1").Cells(65536, 255).Value = lngCount - 1

Else

'Save a copy of the Workbook with the file-name as UniqID
ActiveWorkbook.SaveCopyAs "C:\Documents and Settings\eijaz\Desktop\" &
Worksheets("Sheet1").Cells(1, 1).Value & ".XLS"


'-----NOT able to use these to save only the worksheet1 & not the code
'along with it.(also inorder to decrease the
file-size).--------------------------------------------

'ActiveWorkbook.Worksheets("Sheet1").Copy Filename:= _'
'"C:\Documents and Settings\eijaz\Desktop\" & Worksheets("Sheet1").Cells(1,
1).Value & ".XLS"

'ActiveWorkbook.Worksheets("Sheet1").SaveCopyAs "C:\Documents and
Settings\eijaz\Desktop\" & Worksheets("Sheet1").Cells(1, 1).Value & ".XLS"

'ActiveWorkbook.Worksheets("Sheet1").Copy "C:\Documents and
Settings\eijaz\Desktop\" & Worksheets("Sheet1").Cells(1, 1).Value & ".XLS"
'---------------------------------------------------------------------------
-----------------

'Set the Print Area
setprnt

'Give the Print command
doprnt

End If

End Sub

'If the count is 10 or multiples of 10, then decrement the string from
right.
Sub UniqID(lngCount, strCurr, strPrev)
On Error Resume Next
If lngCount = 10 Then
strPrev = strCurr
strCurr = Application.WorksheetFunction.Replace _
(Arg1:=strCurr, Arg2:=5, _
Arg3:=1, Arg4:="")

ElseIf lngCount = 100 Then
strPrev = strCurr
strCurr = Application.WorksheetFunction.Replace _
(Arg1:=strCurr, Arg2:=4, _
Arg3:=1, Arg4:="")

ElseIf lngCount = 1000 Then
strPrev = strCurr
strCurr = Application.WorksheetFunction.Replace _
(Arg1:=strCurr, Arg2:=3, _
Arg3:=1, Arg4:="")

ElseIf lngCount = 10000 Then
strPrev = strCurr
strCurr = Application.WorksheetFunction.Replace _
(Arg1:=strCurr, Arg2:=2, _
Arg3:=1, Arg4:="")

ElseIf lngCount = 100000 Then
strPrev = strCurr
strCurr = Application.WorksheetFunction.Replace _
(Arg1:=strCurr, Arg2:=1, _
Arg3:=1, Arg4:="")

End If
End Sub

Sub setprnt()
On Error Resume Next
With Worksheets("Sheet1")
.PageSetup.Orientation = xlLandscape
.PageSetup.CenterHorizontally = True
.PageSetup.CenterVertically = True
.LeftMargin = Application.InchesToPoints(0)
.RightMargin = Application.InchesToPoints(0)
.TopMargin = Application.InchesToPoints(0)
.BottomMargin = Application.InchesToPoints(0)
.HeaderMargin = Application.InchesToPoints(0)
.FooterMargin = Application.InchesToPoints(0)
.PrintOut
End With
End Sub

Sub doprnt()
On Error Resume Next
Worksheets("Sheet1").Activate
If ActiveCell(1, 1) = Empty Then
Worksheets("Sheet1").PageSetup.PrintArea = "$A$1:$h$7"
ActiveSheet.PrintOut
Else
ActiveSheet.PageSetup.PrintArea = _
ActiveCell(1, 1).CurrentRegion.Address
ActiveSheet.PrintOut
End If
End Sub

Any suggestions or improvements, pls let me knw!

Thanks & best Regards,

Eijaz Sheikh