Anybody Help with previous question
 

Hi,
I'm getting desperate to solve this, so my apologies for posting this again,
but can anybody offer any help with this previous question. If the link
doesn't work I have copied the orig question below.

http://www.microsoft.com/office/comm...7-92ebb9093772


I have (been given) the code below that will add a row of 'jobs' to a
worksheet named 'Database'. There isa check to see if these jobs have been
already added and a response advising if so.
Is there a way to change the code so that if jobs 1-10 are added, then the
user creates jobs 11-20 he/she can add these also without any problems. At
the moment the code is written so that if any 'jobs' are already found in the
'database' the 'add' function is rejected.
example,
through the morning jobs are entered into the log, lets say jobs 1-10. These
jobs are then added to the database by the user. In the afternoon another
user has created jobs 11-24 and he too adds these to the database.
I want the code to check and see which jobs (if any) have already been added
to the database and then add any outstanding ones.

Hope that is clear and go easy, as I'm quite new to this.

here is the (donated) code.......

Sub add_Anydays_jobs()

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(ActiveSheet.Name)
Set LogWks = Worksheets("Log")
Set RngToCopy = DataWks.Range("a8:n34")

With LogWks
FirstRowToCheck = 5 '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 CStr(RngToCopy.Cells(cRow, cCol).Value) _
= CStr(testRng.Cells(cRow, cCol).Value) Then
'still the same
'so do nothing
Else
If CStr(RngToCopy.Cells(cRow, 2).Value) < "" Then
FoundACellDiff = True
End If
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 "This log has already been copied to the database",
vbExclamation
'exit sub '????
Else
'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
MsgBox "All Today's Jobs Added Successfully !", vbInformation
End If
End With


End Sub



Thanks

If each job is a single row, you could just loop through the rows looking for a
match (in the job id?).

I don't think I'd start with this code as a base.

Maybe something like this...

Option Explicit
Sub testme()

Dim myKeyCell As Range
Dim myRng As Range
Dim myLookUpRng As Range
Dim DataWks As Worksheet
Dim LogWks As Worksheet
Dim res As Variant
Dim destCell As Range

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

With DataWks
Set myRng = .Range("a2:a10") 'whatever it is?
End With

With LogWks
Set myLookUpRng = .Range("a:a")
End With

For Each myKeyCell In myRng.Cells
res = Application.Match(myKeyCell.Value, myLookUpRng, 0)
If IsError(res) Then
'not there
With LogWks
Set destCell = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0)
End With
myKeyCell.EntireRow.Copy _
Destination:=destCell
Else
'key is there
'what happens here
End If
Next myKeyCell

End Sub

(untested, but it compiled ok)

Anthony wrote:

Hi,
I'm getting desperate to solve this, so my apologies for posting this again,
but can anybody offer any help with this previous question. If the link
doesn't work I have copied the orig question below.

http://www.microsoft.com/office/comm...7-92ebb9093772

I have (been given) the code below that will add a row of 'jobs' to a
worksheet named 'Database'. There isa check to see if these jobs have been
already added and a response advising if so.
Is there a way to change the code so that if jobs 1-10 are added, then the
user creates jobs 11-20 he/she can add these also without any problems. At
the moment the code is written so that if any 'jobs' are already found in the
'database' the 'add' function is rejected.
example,
through the morning jobs are entered into the log, lets say jobs 1-10. These
jobs are then added to the database by the user. In the afternoon another
user has created jobs 11-24 and he too adds these to the database.
I want the code to check and see which jobs (if any) have already been added
to the database and then add any outstanding ones.

Hope that is clear and go easy, as I'm quite new to this.

here is the (donated) code.......

Sub add_Anydays_jobs()

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(ActiveSheet.Name)
Set LogWks = Worksheets("Log")
Set RngToCopy = DataWks.Range("a8:n34")

With LogWks
FirstRowToCheck = 5 '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 CStr(RngToCopy.Cells(cRow, cCol).Value) _
= CStr(testRng.Cells(cRow, cCol).Value) Then
'still the same
'so do nothing
Else
If CStr(RngToCopy.Cells(cRow, 2).Value) < "" Then
FoundACellDiff = True
End If
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 "This log has already been copied to the database",
vbExclamation
'exit sub '????
Else
'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
MsgBox "All Today's Jobs Added Successfully !", vbInformation
End If
End With

End Sub

Thanks

--

Dave Peterson