Home |
Search |
Today's Posts |
#1
|
|||
|
|||
VB Code help - please !
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 many thanks |
#2
|
|||
|
|||
Sub add_Anydays_jobs()
Dim DataWks As Worksheet Dim LogWks As Worksheet Dim RngToCopy As Range Dim DestCell As Range Dim cRow As Long Set DataWks = Worksheets(ActiveSheet.Name) Set LogWks = Worksheets("Log") Set RngToCopy = DataWks.Range("a8:n34") Set DestCell = LogWks.Cells(LogWks.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 Sub -- HTH RP (remove nothere from the email address if mailing direct) "Anthony" wrote in message ... 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 many thanks |
#3
|
|||
|
|||
Bob, firstly, may I thank you for some help you gave me the other day on some
VB code (copy invoice data from certain worksheets and paste to invoice data etc etc ??). The other point relating to this question, is that the code you have given, only adds the jobs and it will keep adding the same jobs each time the macro is executed, regardless iof they are already in the 'databade' worksheet. As I explained I want a check to be made to see if the jobs are already there and ONLY ADD the ones that are not. many thanks again for this and your previous help "Bob Phillips" wrote: Sub add_Anydays_jobs() Dim DataWks As Worksheet Dim LogWks As Worksheet Dim RngToCopy As Range Dim DestCell As Range Dim cRow As Long Set DataWks = Worksheets(ActiveSheet.Name) Set LogWks = Worksheets("Log") Set RngToCopy = DataWks.Range("a8:n34") Set DestCell = LogWks.Cells(LogWks.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 Sub -- HTH RP (remove nothere from the email address if mailing direct) "Anthony" wrote in message ... 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 many thanks |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Change case...help please | Excel Worksheet Functions | |||
Make Change Case in Excel a format rather than formula | Excel Worksheet Functions | |||
Opening a file with code without a set file name | Excel Discussion (Misc queries) | |||
Opening a file with code without a set file name | Excel Discussion (Misc queries) | |||
Error trapped only while stepping through the code - Not triggered when run | Excel Discussion (Misc queries) |