Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Anthony
 
Posts: n/a
Default 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   Report Post  
Bob Phillips
 
Posts: n/a
Default

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

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
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
Change case...help please Terry Excel Worksheet Functions 14 October 2nd 05 12:29 PM
Make Change Case in Excel a format rather than formula Kevin Excel Worksheet Functions 1 March 18th 05 08:53 PM
Opening a file with code without a set file name jenkinspat Excel Discussion (Misc queries) 1 March 4th 05 10:50 AM
Opening a file with code without a set file name jenkinspat Excel Discussion (Misc queries) 1 March 3rd 05 03:40 PM
Error trapped only while stepping through the code - Not triggered when run Jeff Excel Discussion (Misc queries) 0 February 28th 05 06:26 PM


All times are GMT +1. The time now is 11:07 AM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"