Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #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
  #2   Report Post  
Dave Peterson
 
Posts: n/a
Default

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
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
Hints And Tips For New Posters In The Excel Newsgroups Gary Brown Excel Worksheet Functions 0 April 15th 05 05:47 PM
Match Last Occurrence of two numbers and Count to Previous Occurence Sam via OfficeKB.com Excel Worksheet Functions 33 April 4th 05 02:17 PM
IF Function with Date revised question taxmom Excel Worksheet Functions 5 February 8th 05 09:40 PM
An easy macro question and one I believe to be a little more diffi TroutKing Excel Worksheet Functions 3 January 18th 05 09:17 PM
Roll back to previous date Jay Excel Worksheet Functions 2 December 3rd 04 03:35 PM


All times are GMT +1. The time now is 05:13 PM.

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"