combining 2 codes

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

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

--
Regards,
Tom Ogilvy


"steve" <[email protected]> wrote in message
news:[email protected]...
> 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
>
>
>

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



"Tom Ogilvy" wrote:

> 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
>
> --
> Regards,
> Tom Ogilvy
>
>
> "steve" <[email protected]> wrote in message
> news:[email protected]...
> > 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
> >
> >
> >
>
>
>