Copy and paste to new workbook macro

Hi all,

I have a macro in a template workbook (jobprogress) that once run, updates another workbook (summary) by adding the data to the next free line.

However, A3 in 'jobprogress' is the project number. Everytime that particular 'jobprogress' is updated (by filling in different columns from B3 to Z3) it sends the data to 'summary' and I end up with multiple rows of the same project - not very useful for a summary sheet! Basically, I would like "before sending data, check if same project number exists in 'summary', if it does then delete that row and insert new data". Is this possible?

Here is the code I have put together with the help of the internet!:

Sub Copy_To_Another_Workbook()
'START CHECK IF OPEN
    '===========================================
'http://www.xcelfiles.com/IsFileOpenVBA.htm
'===========================================

'// Just change the file to test here
Const strFileToOpen As String = "C:\Documents and Settings\user\Desktop\TEST\excel test\proj1\summary.xls"
    If IsFileOpen(strFileToOpen) Then
        MsgBox strFileToOpen & " is already Open" & _
            vbCrLf & "By " & LastUser(strFileToOpen), vbInformation, "File in Use"
    Else
        MsgBox strFileToOpen & " is not open", vbInformation
    End If
End Sub
Function IsFileOpen(strFullPathFileName As String) As Boolean
'// VBA version to check if File is Open
'// We can use this for ANY FILE not just Excel!
'// Ivan F Moala
'// http://www.xcelfiles.com
Dim hdlFile As Long
    '// Error is generated if you try
    '// opening a File for ReadWrite lock >> MUST BE OPEN!
    On Error GoTo FileIsOpen:
    hdlFile = FreeFile
    Open strFullPathFileName For Random Access Read Write Lock Read Write As hdlFile
    IsFileOpen = False
    Close hdlFile
    Exit Function
FileIsOpen:
    '// Someone has it open!
    IsFileOpen = True
    Close hdlFile
End Function
Private Function LastUser(strPath As String) As String
'// Code by Helen from http://www.visualbasicforum.com/index.php?s=
'// This routine gets the Username of the File In Use
'// Credit goes to Helen for code & Mark for the idea
'// Insomniac for xl97 inStrRev
'// Amendment 25th June 2004 by IFM
'// : Name changes will show old setting
'// : you need to get the Len of the Name stored just before
'// : the double Padded Nullstrings
Dim strXl As String
Dim strFlag1 As String, strflag2 As String
Dim i As Integer, j As Integer
Dim hdlFile As Long
Dim lNameLen As Byte

strFlag1 = Chr(0) & Chr(0)
strflag2 = Chr(32) & Chr(32)
hdlFile = FreeFile
Open strPath For Binary As #hdlFile
    strXl = Space(LOF(hdlFile))
    Get 1, , strXl
Close #hdlFile
j = InStr(1, strXl, strflag2)
#If Not VBA6 Then
    '// Xl97
    For i = j - 1 To 1 Step -1
        If Mid(strXl, i, 1) = Chr(0) Then Exit For
    Next
    i = i + 1
#Else
    '// Xl2000+
    i = InStrRev(strXl, strFlag1, j) + Len(strFlag1)
#End If
'// IFM
lNameLen = Asc(Mid(strXl, i - 3, 1))
LastUser = Mid(strXl, i, lNameLen)
'END CHECK IF OPEN

'START COPY TO SUMMARY SHEET
    Dim SourceRange As Range
    Dim DestRange As Range
    Dim DestWB As Workbook
    Dim DestSh As Worksheet
    Dim Lr As Long
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
    'Change the file name (2*) and the path/file name to your file
    If bIsBookOpen_RB("summary.xls") Then
        Set DestWB = Workbooks("summary.xls")
    Else
        Set DestWB = Workbooks.Open("C:\Documents and Settings\user\Desktop\TEST\excel test\proj1\summary.xls")
    End If
    'Change the Source Sheet and range
    Set SourceRange = ThisWorkbook.Sheets("Sheet1").Range("A3:Z3")
    'Change the sheet name of the database workbook
    Set DestSh = DestWB.Worksheets("Sheet1")

    Lr = LastRow(DestSh)
    Set DestRange = DestSh.Range("A" & Lr + 1)
    'We make DestRange the same size as SourceRange and use the Value
    'property to give DestRange the same values
    With SourceRange
        Set DestRange = DestRange.Resize(.Rows.Count, .Columns.Count)
    End With
    DestRange.Value = SourceRange.Value
    DestWB.Close savechanges:=True
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
'END COPY TO SUMMARY SHEET
End Function

and the function:

Function bIsBookOpen_RB(ByRef szBookName As String) As Boolean
' Rob Bovey
    On Error Resume Next
    bIsBookOpen_RB = 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

Any help would be greatly appreciated

Threads also open:
http://www.mrexcel.com/forum/showthread.php?t=569573 & http://www.ozgrid.com/forum/showthread.php?t=157022

Hi and welcome to the forum.

Unfortunately:

Your post does not comply with Rule 8 of our Forum RULES. Cross-posting is when you post the same question in other forums on the web. You'll find people are disinclined to respond to cross-posts because they may be wasting their time solving a problem that has been solved elsewhere. We prefer that you not cross-post at all, but if you do (and it's unlikely to go unnoticed), you MUST provide a link (copy the url from the address bar in your browser)to the cross-post. Expect cross-posts without a link to be closed a message will be posted by the moderator explaining why. We are here to help so help us help you!

Read this to understand why we ask you to do this, and then please edit your first post here to include links to any and all cross posts in other forums.