Hi all,

I have this code which runs a macro to add a complete list of all data for
'today' to be entered into a sepeate worksheet which is called the database.
Is there a way, if so how, that the code can be changed so that if the
'same' data is entered twice a pop up message box is shown to alert the user
of this and stop this happening.

The code I have is

Sub add_Anydays_jobs()
With ActiveSheet.Range("A8:N34")
Sheets("Log").Range("A" & Rows.Count).End(xlUp).Offset( _
1, 0).Resize(.Rows.Count, .Columns.Count).Value = .Value

End With
MsgBox "All Today's Jobs Added Successfully !", vbInformation
End Sub

thanks all

I think you'll have to check the log sheet lots of times.

Sarting in A1(?), you'll have to check 378 cells (14 columns by 27 rows) to see
if all the values match up.

If you find a difference, drop down a row and start checking again.

If that 27 rows is an exact match, then set a flag, drop out of the loop and
issue a warning message.



Anthony wrote:

Hi all,

I have this code which runs a macro to add a complete list of all data for
'today' to be entered into a sepeate worksheet which is called the database.
Is there a way, if so how, that the code can be changed so that if the
'same' data is entered twice a pop up message box is shown to alert the user
of this and stop this happening.

The code I have is

Sub add_Anydays_jobs()
With ActiveSheet.Range("A8:N34")
Sheets("Log").Range("A" & Rows.Count).End(xlUp).Offset( _
1, 0).Resize(.Rows.Count, .Columns.Count).Value = .Value

End With
MsgBox "All Today's Jobs Added Successfully !", vbInformation
End Sub

thanks all

--

Dave Peterson

Dave
Sounds good, but sorry I'm a bit of a novice in VB, can you supply any
script to do this ?
many thanks

"Dave Peterson" wrote:

I think you'll have to check the log sheet lots of times.

Sarting in A1(?), you'll have to check 378 cells (14 columns by 27 rows) to see
if all the values match up.

If you find a difference, drop down a row and start checking again.

If that 27 rows is an exact match, then set a flag, drop out of the loop and
issue a warning message.



Anthony wrote:

Hi all,

I have this code which runs a macro to add a complete list of all data for
'today' to be entered into a sepeate worksheet which is called the database.
Is there a way, if so how, that the code can be changed so that if the
'same' data is entered twice a pop up message box is shown to alert the user
of this and stop this happening.

The code I have is

Sub add_Anydays_jobs()
With ActiveSheet.Range("A8:N34")
Sheets("Log").Range("A" & Rows.Count).End(xlUp).Offset( _
1, 0).Resize(.Rows.Count, .Columns.Count).Value = .Value

End With
MsgBox "All Today's Jobs Added Successfully !", vbInformation
End Sub

thanks all

--

Dave Peterson

Ouch. I was afraid of that followup!

This worked for me under minor testing...

Option Explicit
Sub add_Anydays_jobs2()

Dim DataWks As Worksheet
Dim LogWks As Worksheet
Dim FoundACellDiff As Boolean
Dim FoundAGroupMatch As Boolean
Dim RngToCopy As Range
Dim testRng As Range

Dim iRow As Long
Dim FirstRowToCheck As Long
Dim LastRowToCheck As Long

Dim cCol As Long
Dim cRow As Long

Dim DestCell As Range

Set DataWks = Worksheets("sheet1")
Set LogWks = Worksheets("Log")

Set RngToCopy = DataWks.Range("a8:n34")

With LogWks
FirstRowToCheck = 2 'headers?
LastRowToCheck = .Cells(.Rows.Count, "A").End(xlUp).Row

FoundAGroupMatch = False
For iRow = FirstRowToCheck To LastRowToCheck
'topleftcell of possible range to paste
Set testRng = .Cells(iRow, "A")
FoundACellDiff = False
For cRow = 1 To RngToCopy.Rows.Count
For cCol = 1 To RngToCopy.Columns.Count
If RngToCopy.Cells(cRow, cCol).Value _
= testRng.Cells(cRow, cCol).Value Then
'still the same
'so do nothing
Else
FoundACellDiff = True
Exit For
End If
Next cCol
If FoundACellDiff Then
Exit For
End If
Next cRow
If FoundACellDiff = False Then
FoundAGroupMatch = True
Exit For
End If
Next iRow


If FoundAGroupMatch = True Then
MsgBox "Those values already exist!"
'exit sub '????
Else
MsgBox "Hey, they look unique"
'do the copy?
Set DestCell = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0)
DestCell.Resize(RngToCopy.Rows.Count, _
RngToCopy.Columns.Count).Value _
= RngToCopy.Value
End If
End With
End Sub

Anthony wrote:

Dave
Sounds good, but sorry I'm a bit of a novice in VB, can you supply any
script to do this ?
many thanks

"Dave Peterson" wrote:

I think you'll have to check the log sheet lots of times.

Sarting in A1(?), you'll have to check 378 cells (14 columns by 27 rows) to see
if all the values match up.

If you find a difference, drop down a row and start checking again.

If that 27 rows is an exact match, then set a flag, drop out of the loop and
issue a warning message.



Anthony wrote:

Hi all,

I have this code which runs a macro to add a complete list of all data for
'today' to be entered into a sepeate worksheet which is called the database.
Is there a way, if so how, that the code can be changed so that if the
'same' data is entered twice a pop up message box is shown to alert the user
of this and stop this happening.

The code I have is

Sub add_Anydays_jobs()
With ActiveSheet.Range("A8:N34")
Sheets("Log").Range("A" & Rows.Count).End(xlUp).Offset( _
1, 0).Resize(.Rows.Count, .Columns.Count).Value = .Value

End With
MsgBox "All Today's Jobs Added Successfully !", vbInformation
End Sub

thanks all

--

Dave Peterson


--

Dave Peterson

Dave,
whan I have a spare minute (kids!) I'll give ur code a try, but hey, many
thanks for the stuff posted here, I'll let you know how I get on
many thanks
Anthony

"Dave Peterson" wrote:

Ouch. I was afraid of that followup!

This worked for me under minor testing...

Option Explicit
Sub add_Anydays_jobs2()

Dim DataWks As Worksheet
Dim LogWks As Worksheet
Dim FoundACellDiff As Boolean
Dim FoundAGroupMatch As Boolean
Dim RngToCopy As Range
Dim testRng As Range

Dim iRow As Long
Dim FirstRowToCheck As Long
Dim LastRowToCheck As Long

Dim cCol As Long
Dim cRow As Long

Dim DestCell As Range

Set DataWks = Worksheets("sheet1")
Set LogWks = Worksheets("Log")

Set RngToCopy = DataWks.Range("a8:n34")

With LogWks
FirstRowToCheck = 2 'headers?
LastRowToCheck = .Cells(.Rows.Count, "A").End(xlUp).Row

FoundAGroupMatch = False
For iRow = FirstRowToCheck To LastRowToCheck
'topleftcell of possible range to paste
Set testRng = .Cells(iRow, "A")
FoundACellDiff = False
For cRow = 1 To RngToCopy.Rows.Count
For cCol = 1 To RngToCopy.Columns.Count
If RngToCopy.Cells(cRow, cCol).Value _
= testRng.Cells(cRow, cCol).Value Then
'still the same
'so do nothing
Else
FoundACellDiff = True
Exit For
End If
Next cCol
If FoundACellDiff Then
Exit For
End If
Next cRow
If FoundACellDiff = False Then
FoundAGroupMatch = True
Exit For
End If
Next iRow


If FoundAGroupMatch = True Then
MsgBox "Those values already exist!"
'exit sub '????
Else
MsgBox "Hey, they look unique"
'do the copy?
Set DestCell = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0)
DestCell.Resize(RngToCopy.Rows.Count, _
RngToCopy.Columns.Count).Value _
= RngToCopy.Value
End If
End With
End Sub

Anthony wrote:

Dave
Sounds good, but sorry I'm a bit of a novice in VB, can you supply any
script to do this ?
many thanks

"Dave Peterson" wrote:

I think you'll have to check the log sheet lots of times.

Sarting in A1(?), you'll have to check 378 cells (14 columns by 27 rows) to see
if all the values match up.

If you find a difference, drop down a row and start checking again.

If that 27 rows is an exact match, then set a flag, drop out of the loop and
issue a warning message.



Anthony wrote:

Hi all,

I have this code which runs a macro to add a complete list of all data for
'today' to be entered into a sepeate worksheet which is called the database.
Is there a way, if so how, that the code can be changed so that if the
'same' data is entered twice a pop up message box is shown to alert the user
of this and stop this happening.

The code I have is

Sub add_Anydays_jobs()
With ActiveSheet.Range("A8:N34")
Sheets("Log").Range("A" & Rows.Count).End(xlUp).Offset( _
1, 0).Resize(.Rows.Count, .Columns.Count).Value = .Value

End With
MsgBox "All Today's Jobs Added Successfully !", vbInformation
End Sub

thanks all

--

Dave Peterson


--

Dave Peterson