ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Discussion (Misc queries) (https://www.excelbanter.com/excel-discussion-misc-queries/)
-   -   VB Code help - please ! (https://www.excelbanter.com/excel-discussion-misc-queries/36864-vbulletin-code-help-please.html)

Anthony

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

Bob Phillips

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




Anthony

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






All times are GMT +1. The time now is 08:45 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com