Duplicate Entries

[Heera]

Hi All,

I have 5 users working on a macro. All of them are using different
workbooks from there desktops but the macro is same.

At the end of the when the work is done all of them transfer their
data to a workbook(well I call it datadump) which is located in shared
drive. Some times when the users transfers the data to the datadump
workbook duplicate entries are created.

For an example: User one has done ten case studies in a day, at the
end of the day before leaving he will transfer the data to the
datadump workbook which is on shared drive and on the other day when i
generate the report I see 20 case studies. It has happned very few
times but I am not able to understand the cause.

I dont know what is going wrong. Please help....

Regards
Heera Chavan

 

[Paul Robinson]

Hi
You have provided no information which might help someone else to
solve your problem.

"Transfer data" - is this done using code? What is the code?
"Generate Report" - is this done using code? What is the code?

regards
Paul

 

[Heera]

Hi
You have provided no information which might help someone else to
solve your problem.

"Transfer data" - is this done using code? What is the code?
"Generate Report" - is this done using code? What is the code?

regards
Paul








- Show quoted text -

Hi Paul,

Thank you for your reply here is my script. Summary tab is in the user
workbook and it contains the details of his case studies which he has
done during the day. And the user transfer's the data from summary tab
to "Raw Data" tab of Datadump workbook which is in shared drive. I
hope this will help you to understand the issue. However I think the
problem is with the network but this issue is giving me lot of
problems.

Sub Transfer()

Application.ScreenUpdating = False
Sheets("Summary").Select
Dim DBPath As String 'delare the variable for database path
Dim DBName As String 'delare the variable for database Name
Dim Myfile As String



DBPath = ThisWorkbook.Sheets("Cover").Range("B1").Value 'the address
where the database path is mentioned in the macro workbook.
DBName = ThisWorkbook.Sheets("Cover").Range("B5").Value 'the address
where the database file name is mentioned in the macro workbook.

Myfile = Dir(DBPath & "\" & DBName)

If Myfile = "" Then

MsgBox "Macro cannot continue with this operation because of the
following possibilities." & vbCrLf & _
"1. Mentioned Path is not accessable." & vbCrLf & "2. Required
File is not available" & vbCrLf & _
"3. Correct File name or File Path is updated." & vbCrLf & "4.
Network is disconnected.", vbInformation, Title:="FSS"
Errorhandel (bstatusb)
Range("A7").Select
Exit Sub

End If

Application.DisplayAlerts = False
Workbooks.Open Filename:=(DBPath & "\" & DBName)

Application.DisplayAlerts = False

If ActiveWorkbook.ReadOnly = True Then

Application.DisplayAlerts = False
Application.WindowState = xlMinimized
MsgBox "Other user is updating data in the database. Try to
transfer the data after some time.", vbInformation, Title:="FSS"
Errorhandel (bstatusb)
Windows(DBName).Close
ThisWorkbook.Activate
Range("A7").Select
Exit Sub

End If

Sheets("Raw Data").Select
ActiveSheet.Unprotect Password:="youknowit@$1"

ThisWorkbook.Activate

Row("6:" & Cells(60000, 1).End(xlUp).Row).Entirerow.select
Selection.Copy

Windows(DBName).Activate
Cells(60000, 1).End(xlUp).Offset(1,0).Select


Sheets("Raw Data").Select
Range("A1").Select
ActiveSheet.Protect Password:="youknowit@$1"
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.RowHeight = 15
Range("A1").Select
ActiveSheet.Protect Password:="youknowit@$1"
ActiveWorkbook.Save

If Workbooks(DBName).Saved Then

Windows(DBName).Close
ThisWorkbook.Activate
Selection.Copy
Sheets("BackupSheet").Select
Cells(80000, 1).End(xlUp).Offset(1, 0).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Sheets("Summary").Select
ActiveSheet.Unprotect Password:="youknowit@$1"
Selection.EntireRow.Delete Shift:=xlUp
ActiveCell.Select
ThisWorkbook.Save
ActiveSheet.Protect Password:="youknowit@$1"

Else

Application.DisplayAlerts = False
Windows(DBName).Close
ThisWorkbook.Activate
Range("A7").Select
ThisWorkbook.Save
MsgBox "Due to technical problem the data is not saved in the
database." & Chr(10) & _
"Kindly trasfer the data once again."

End If


MsgBox "Done.", vbInformation

Exit Sub