View Single Post
  #1   Report Post  
Anthony
 
Posts: n/a
Default 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