Random rows being overwritten on 'data store' workbook after copying from input workbook

[tmillo]

Hi All,

I have a problem with something I created using all the tips you guys have provided from the forum.

I have two workbooks; one for inputting quality assurance scores and one which has the scores stored. They are copied over using a simple bit of code

“Windows("Main.xls").Activate
Range("B4").Select
Selection.Copy
Windows("DataStore.xls").Activate
Range("E" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues”

I use this as each cell corresponds to a cell on the data store workbook, but has to be on a separate workbook due to sensitive information used in the check.
The process works 95/96% of the time but it seems randomly when checks occur instead of finding the next available row in the data store, it selects a random row and overwrites that. This has happened to 3 rows a total of 4 times (twice on row 51) out of 220 checks.
What on earth could be causing such weird and unpredictable errors?

[BadlySpelledBuoy]

Could column E in the pasted in row have a blank cell? That would mean that when the code finds the last row and offsets by 1 to ascertain the next row to past into, it will be looking at the wrong row and overwrite what was there.

BSB

[BadlySpelledBuoy]

Also, you don't really need to activate sheets and select ranges to be able to manipulate them. This often just slows things down.
The two lines below should do the same as your 5 lines above.

Please Login or Register  to view this content.

BSB

[tmillo]

Could column E in the pasted in row have a blank cell? That would mean that when the code finds the last row and offsets by 1 to ascertain the next row to past into, it will be looking at the wrong row and overwrite what was there.

BSB

Unfortunately not! We've locked down cells on the main sheet so they can't leave them blank when submitting.

Also, you don't really need to activate sheets and select ranges to be able to manipulate them. This often just slows things down.
The two lines below should do the same as your 5 lines above.

Please Login or Register  to view this content.

BSB

oo brilliant, when I manage to fix this I'll start editing it to make it better

[BadlySpelledBuoy]

Any chance we could see a desensitized version of the workbook?
Makes these issues far easier to diagnose.

BSB

[tmillo]

Any chance we could see a desensitized version of the workbook?
Makes these issues far easier to diagnose.

BSB

Unfortunately due to the nature of the document, the whole main page is sensitive and would require basically deleting. I think the main issue is with our second module, used to click submit on the main sheet which then copies all the data to the database.

The module 2 code I can share, which is

Function IsFileOpen(FileName As String)
Dim iFilenum As Long
Dim iErr As Long

On Error Resume Next
iFilenum = FreeFile()
Open FileName For Input Lock Read As #iFilenum
Close iFilenum
iErr = Err
On Error GoTo 0

Select Case iErr
Case 0: IsFileOpen = False
Case 70: IsFileOpen = True
Case Else: Error iErr
End Select

End Function


Sub submit()

Application.ScreenUpdating = False

If Not IsFileOpen("file path QA Database.xls") Then
Workbooks.Open "file path QA Database.xls"
End If


Workbooks("QA Database.xls").Activate
Workbooks("QA Database.xls").Worksheets("Database").Select

ActiveSheet.Unprotect ("password goes here")

Windows("QA.xls").Activate

ActiveSheet.Unprotect ("password here")
If MsgBox("Choose OK to submit these results to the database. Please 'RESET' the form before resubmitting another check. If this form says changes have been made to the Database, select keep changes and then resubmit", vbOKCancel) = vbOK Then
Application.EnableEvents = False

If Range("Z17").Value = "1" Then
MsgBox "Data already copied to QA log"
Exit Sub
End If

Range("Z17") = 0

If Range("B4").Value = "" Then
MsgBox "Please Enter Case owner name"
Exit Sub
End If

If Range("B5").Value = "" Then
MsgBox "Please Enter reference"
Exit Sub
End If

If Range("B6").Value = "" Then
MsgBox "Please Enter Outcome Date"
Exit Sub
End If

If Range("D4").Value = "" Then
MsgBox "Please Enter your name"
Exit Sub
End If

If Range("C9").Value = "" Then
MsgBox "Cells cannot be left blank, please select N/A"
Exit Sub

End If


If Range("C10").Value = "" Then
MsgBox "Cells cannot be left blank, please select N/A"
Exit Sub

End If

If Range("C11").Value = "" Then
MsgBox "Cells cannot be left blank, please select N/A"
Exit Sub

End If

If Range("C12").Value = "" Then
MsgBox "Cells cannot be left blank, please select N/A"
Exit Sub

End If

If Range("C13").Value = "" Then
MsgBox "Cells cannot be left blank, please select N/A"
Exit Sub

End If

If Range("C14").Value = "" Then
MsgBox "Cells cannot be left blank, please select N/A"
Exit Sub

End If

If Range("C15").Value = "" Then
MsgBox "Cells cannot be left blank, please select N/A"
Exit Sub

End If

If Range("C16").Value = "" Then
MsgBox "Cells cannot be left blank, please select N/A"
Exit Sub

End If

If Range("C17").Value = "" Then
MsgBox "Cells cannot be left blank, please select N/A"
Exit Sub

End If

If Range("C18").Value = "" Then
MsgBox "Cells cannot be left blank, please select N/A"
Exit Sub

End If

If Range("C19").Value = "" Then
MsgBox "Cells cannot be left blank, please select N/A"
Exit Sub

End If

If Range("C20").Value = "" Then
MsgBox "Cells cannot be left blank, please select N/A"
Exit Sub

End If

If Range("C21").Value = "" Then
MsgBox "Cells cannot be left blank, please select N/A"
Exit Sub

End If

If Range("C22").Value = "" Then
MsgBox "Cells cannot be left blank, please select N/A"
Exit Sub

End If




Range("B4").Select
Selection.Copy
Windows("QA Database.xls").Activate
Range("C" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues


Windows("QA.xls").Activate
Range("B5").Select
Selection.Copy
Windows("QA Database.xls").Activate
Range("E" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues

Windows("QA.xls").Activate
Range("B7").Select
Selection.Copy
Windows("QA Database.xls").Activate
Range("BC" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues

Windows("QA.xls").Activate
Range("D4").Select
Selection.Copy
Windows("QA Database.xls").Activate
Range("BA" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues

Windows("QA.xls").Activate
Range("D5").Select
Selection.Copy
Windows("QA Database.xls").Activate
Range("D" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues

Windows("QA.xls").Activate
Range("B6").Select
Selection.Copy
Windows("QA Database.xls").Activate
Range("B" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues

Windows("QA.xls").Activate
Range("D6").Select
Selection.Copy
Windows("QA Database.xls").Activate
Range("BB" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues


Windows("QA.xls").Activate
Range("A3").Select
Selection.Copy
Windows("QA Database.xls").Activate
Range("F" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues

Windows("QA.xls").Activate
Range("C9").Select
Selection.Copy
Windows("QA Database.xls").Activate
Range("H" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues

Windows("QA.xls").Activate
Range("C10").Select
Selection.Copy
Windows("QA Database.xls").Activate
Range("I" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues

Windows("QA.xls").Activate
Range("C11").Select
Selection.Copy
Windows("QA Database.xls").Activate
Range("J" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues

Windows("QA.xls").Activate
Range("C12").Select
Selection.Copy
Windows("QA Database.xls").Activate
Range("K" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues

Windows("QA.xls").Activate
Range("C13").Select
Selection.Copy
Windows("QA Database.xls").Activate
Range("L" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues

Windows("QA.xls").Activate
Range("C14").Select
Selection.Copy
Windows("QA Database.xls").Activate
Range("M" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues

Windows("QA.xls").Activate
Range("C15").Select
Selection.Copy
Windows("QA Database.xls").Activate
Range("N" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues

Windows("QA.xls").Activate
Range("C16").Select
Selection.Copy
Windows("QA Database.xls").Activate
Range("O" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues

Windows("QA.xls").Activate
Range("C17").Select
Selection.Copy
Windows("QA Database.xls").Activate
Range("P" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues

Windows("QA.xls").Activate
Range("C18").Select
Selection.Copy
Windows("QA Database.xls").Activate
Range("Q" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues

Windows("QA.xls").Activate
Range("C19").Select
Selection.Copy
Windows("QA Database.xls").Activate
Range("R" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues

Windows("QA.xls").Activate
Range("C20").Select
Selection.Copy
Windows("QA Database.xls").Activate
Range("S" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues

Windows("QA.xls").Activate
Range("C21").Select
Selection.Copy
Windows("QA Database.xls").Activate
Range("T" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues

Windows("QA.xls").Activate
Range("C22").Select
Selection.Copy
Windows("QA Database.xls").Activate
Range("U" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues



Windows("QA.xls").Activate
ChDir "File path"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:="file path" & Range("B4").Value & Range("J5").Value & Range("B5").Value _
, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=False
Windows("QA Database.xls").Activate

ActiveWorkbook.Save
ActiveWorkbook.Close

MsgBox "Your scores have been successfully submitted!"

Application.EnableEvents = True
Else
Exit Sub
End If



End Sub

Sub SavePDF()
'
' SavePDF Macro
'

'
ChDir "file path"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:=Range("B4").Value _
, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=True
End Sub

Column C from C9 down is the scoring input cell. The first lot of code makes it error on blank and the second lot copies it to the database.

The other cells it asks to copy are random other bits of information. I've had to delete a few repeated codes to fit into the letter limit for the forum

[BadlySpelledBuoy]

Quick question, when this code pastes the data into QA Database.xls will the values all be pasted on the same row, but in their respective columns?

Reason I ask is you're checking for a next available row for each column but if these SHOULD all result in the same row then not only could you make this code more efficient but it may also iron out the issue you're having.

BSB

[tmillo]

Quick question, when this code pastes the data into QA Database.xls will the values all be pasted on the same row, but in their respective columns?

Reason I ask is you're checking for a next available row for each column but if these SHOULD all result in the same row then not only could you make this code more efficient but it may also iron out the issue you're having.

BSB

Yes they are. Each row in the 'database' represents a specific check with the next one being on the row below. It all worked perfectly with no issues then when we got to roughly row 80 the next check went back and overwrote row 51. This then led three more to overwrite on the same rows before randomly going back to 81-82 etc. We can't seem to replicate the issue causing it, but it has also happened later on on other rows twice.

[BadlySpelledBuoy]

I have made a mock up of your workbook and used the section of your code that pastes from one to the other. I've run it over 300 times and not once has it overwritten a previously populated row. Which just means I cannot fathom what's going wrong in your workbook and probably wouldn't be able to without seeing it.

I would try amending your code by adding this section at the beginning of the Sub submit() section:

Please Login or Register  to view this content.

This works by specifying what the next empty row is just once and using that value for each paste as opposed to working it out for each column.

And then using this approach to paste from one workbook to the other. I've only done the first three, but you should get the idea:

Please Login or Register  to view this content.

I cannot promise it will solve the issue as I cannot replicate it and have no idea what's causing it.

BSB

[tmillo]

I have made a mock up of your workbook and used the section of your code that pastes from one to the other. I've run it over 300 times and not once has it overwritten a previously populated row. Which just means I cannot fathom what's going wrong in your workbook and probably wouldn't be able to without seeing it.

I would try amending your code by adding this section at the beginning of the Sub submit() section:

Please Login or Register  to view this content.

This works by specifying what the next empty row is just once and using that value for each paste as opposed to working it out for each column.

And then using this approach to paste from one workbook to the other. I've only done the first three, but you should get the idea:

Please Login or Register  to view this content.

I cannot promise it will solve the issue as I cannot replicate it and have no idea what's causing it.

BSB

Thank you, I'll try that and hopefully it stops. Thanks for all your help!

Random thought, would me editing anything in the database possibly make the code think that is the last used row or does that part look specifically for the next available row?I havent personally been in and edited anything, but I wouldn't put it past colleagues

[BadlySpelledBuoy]

I can only think that would happen if the cells were edited to be blank. That way there's a chance your original code could think it had found the last row when it actually hadn't.

BSB