I have the following code that looks to see if there is a duplicate row of data (based on first 4 cells of first row) in the database. If there isn't a row, it copies it to the first unused row, otherwise it asks the user if they want to replace it or cancel. It runs right the first time to replace a row, but if I run it again it doesn't present the messagebox and instead, selects the first row in the database and replaces that row. If I close out the workbook and run the code when I reopen the workbook, it replaces the duplicate row just fine. There must be something that is not resetting but I can't figure it out. Any ideas?
Code:
Option Explicit
Dim iRow As Long
Dim ws As Worksheet
Dim Answer As Integer
Dim DATA As Range
Dim Row As Range
Private Sub results_copy()
Set ws = ActiveWorkbook.Worksheets("Support Levels")
ws.Select
'set Data range minus row with column labels
With Range("DATA")
Set DATA = .Offset(1, 0).Resize(.Rows.Count - 1)
End With
'sort to find any rows matching first five cells in row that I want to add
Call Find_Match
'If there are no records found, then copy row to last row
If ws.Range("A2").Value = 0 Then 'A2 us subtotal of found rows
Call Reset_Autofilter
Call DataEnter
ActiveWorkbook.Worksheets("INPUT").Select
Exit Sub
Else
Call Calc_Manual 'turn off autoCalc to make search faster
For Each Row In DATA.Rows
'Message Box to prompt user that there is already a matching Record on the Support Levels tab
If Row.EntireRow.Hidden = False Then Answer = MsgBox(Prompt:="Matching record found, replace it?", Buttons:=vbOKCancel + vbQuestion, Title:="MATCHING RECORD FOUND!")
If Answer = vbOK Then
Row.EntireRow.Select 'select row that is not hidden and replace with row I need to add
ws.Range("A1").EntireRow.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Exit For
End If
Next Row
End If
'reset autofilter and auto calc and return to input page
Call Reset_Autofilter
Call Calc_Auto
ActiveWorkbook.Worksheets("INPUT").Select
End Sub
Private Sub DataEnter()
Set ws = Worksheets("Support Levels")
'find first empty row in database
iRow = ws.Range("A3").End(xlDown).Offset(1, 0).Row
'Row to be copied
ws.Cells(iRow, 1).Select
ws.Range("A1").EntireRow.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub
Private Sub Find_Match()
Set ws = ActiveWorkbook.Worksheets("Support Levels")
' Find_Match Macro
' Macro recorded 5/26/2011 by Dean_hess
ws.Range("A3").Select
Selection.AutoFilter Field:=1, Criteria1:=Range("A1").Value
Selection.AutoFilter Field:=2, Criteria1:=Range("B1").Value
Selection.AutoFilter Field:=3, Criteria1:=Range("C1").Value
Selection.AutoFilter Field:=4, Criteria1:=Range("D1").Value
Selection.AutoFilter Field:=5, Criteria1:=Range("E1").Value
End Sub
Private Sub Reset_Autofilter()
Worksheets("Support Levels").Select
With ActiveSheet
If .AutoFilterMode Then
If .FilterMode Then
.ShowAllData
End If
End If
End With
End Sub
Private Sub Calc_Manual()
With Application
.Calculation = xlManual
.MaxChange = 0.001
End With
End Sub
Private Sub Calc_Auto()
With Application
.Calculation = xlAutomatic
.MaxChange = 0.001
End With
End Sub
Code runs right first time but not second time
