Home |
Search |
Today's Posts |
#1
![]() |
|||
|
|||
![]()
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 |
#2
![]() |
|||
|
|||
![]()
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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
Hints And Tips For New Posters In The Excel Newsgroups | Excel Worksheet Functions | |||
Match Last Occurrence of two numbers and Count to Previous Occurence | Excel Worksheet Functions | |||
IF Function with Date revised question | Excel Worksheet Functions | |||
An easy macro question and one I believe to be a little more diffi | Excel Worksheet Functions | |||
Roll back to previous date | Excel Worksheet Functions |