combining 2 codes

[Guest]

here are two codes i have that i want to synchronize

1) This one searches a column for the largets Estimate number (E05001,
E05002...) Then returns the next one in series.


Sub AddItem()
Dim r As String, rmax As String
r = Range("A65536").End(xlUp).Row
rmax = Application.Evaluate("MAX(VALUE(RIGHT(A2:A" & r & ",5)))")
Cells(r + 1, 1) = "E" & Format(rmax + 1, "00000")
End Sub

2) I got this code from Ron's site. I want to use this with (1) Above so
that i can check a list of Estimate numbers on the destWB, and return the
next one in series to the workbook I am in. The workbook i am in would have
a button to automate this.


Sub copy_to_another_workbook()
'¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯
Dim sourceRange As Range
Dim destrange As Range
Dim destWB As Workbook
Dim Lr As Long

Application.ScreenUpdating = False
If bIsBookOpen("DATABASE.xls") Then
Set destWB = Workbooks("DATABASE.xls")
Else
Set destWB = Workbooks.Open("C:\Documents and
Settings\steve\Desktop" & "\" & "DATABASE")
End If

Lr = LastRow(destWB.Worksheets("Sheet1")) + 1

Set sourceRange = ThisWorkbook.Worksheets("Sheet1").Range("A4:C4")
' look for job name in existing list, exit if found
If Not destWB.Worksheets("Sheet1").Range("A3:A" & Lr -
1).Find(What:=sourceRange.Cells(1, 1), LookAt:=xlWhole) Is Nothing Then
MsgBox "This Job Name already exists"
Application.Goto
Reference:=ThisWorkbook.Worksheets("Sheet1").Range("A4"), _
scroll:=False


GoTo CleanUp
End If


If Not destWB.Worksheets("Sheet1").Range("B3:B" & Lr -
1).Find(What:=sourceRange.Cells(1, 2), LookAt:=xlWhole) Is Nothing Then
MsgBox "This Estimate Code already exists"
GoTo CleanUp
End If


Set destrange = destWB.Worksheets("Sheet1").Range("A" & Lr)
sourceRange.Copy
destrange.PasteSpecial xlPasteValues, , False, False
Application.CutCopyMode = False

CleanUp:


destWB.Close True
Application.ScreenUpdating = True
End Sub

Function bIsBookOpen(ByRef szBookName As String) As Boolean
'¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯
' Rob Bovey
On Error Resume Next
bIsBookOpen = Not (Application.Workbooks(szBookName) Is Nothing)
End Function

Function LastRow(sh As Worksheet)
'¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function

 

[Tom Ogilvy]

Sub Get_Number_From_another_workbook()
'¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯
Dim destrange As Range
Dim destWB As Workbook
Dim Lr As Long
Dim rmax as Long

Application.ScreenUpdating = False
If bIsBookOpen("DATABASE.xls") Then
Set destWB = Workbooks("DATABASE.xls")
Else
Set destWB = Workbooks.Open( _
"C:\Documents and Settings\steve\Desktop" _
& "\" & "DATABASE.xls")
End If

Lr = LastRow(destWB.Worksheets("Sheet1"))

set rng = destWB.Worksheets("Sheet1").Range("A3:A" & Lr)
rmax = Application.Evaluate("MAX(VALUE(RIGHT(" &
rng.address(1,1,xlA1,True) & _
& ",5)))")

msgbox rmax

End Sub

 

[Guest]

awesome, exactly what i needed

quick question.....

if i use VBA to create a sysem folder, is it possible to change the view in
that folder?

manually, it would be like this:

create folder
name it
choose VIEW then DETAILS