Hi JLatham,
Your code is much appreciated as it must have taken a lot of your time and
great efforts. With regret that I did not adopt your code, I am unable to
modify your profound codes in fitting my needs. I understand that there isnt
anything wrong in your code but only was your profound codes just far beyond
the limited knowledge in my beginner phase. However, I have bookmarked this
thread for my future usages. Once again €¦ thank you for your assistance in
this coding.
Rgds


"JLatham" wrote:

I believe that the following code, plased in WB 2 (one with AA and BB sheets
in it) will do the trick for you. You should make a copy of that workbook to
test with, just to protect yourself from any mistake I may have made! I've
only tested it with very minimal data.

To use it, open that workbook and run the macro, it will ask you to browse
to find the other workbook and once you do that, it will open the other
workbook and copy over any new AA/BB invoices that are dated the same as
"today" and that have invoice numbers that don't already exist on sheets
AA/BB.

To put the code into that workbook, open it up and press [Alt]+[F11] to open
the VB Editor and then choose Insert -- Module. Copy the code below and
paste it into the code module. Look for any red lines of entry - those would
be ones that got broken up improperly by the editor in this forum.

The code:

Sub CopyNewInvoices()
Const ws1Name = "AA"
Const ws2Name = "BB"
Const NameCol = "B"
Const InvNoCol = "D"
Const InvDateCol = "E"
Const FirstColToCopy = "D"
Const LastColToCopy = "K"

Dim WB1Name As String
Dim WB1 As Workbook
Dim WS1 As Worksheet
Dim WS1NamesRange As Range
Dim anyWS1Name As Range
Dim WB2 As Workbook
Dim WB2WS As Worksheet
Dim WB2CurrentInvoices As Range
Dim anyWB2Invoice As Range
Dim offset2InvNo As Integer
Dim offset2Date As Integer
Dim foundFlag As Boolean
Dim sourceRange As Range
Dim destRange As Range
Dim nextWB2Row As Long

WB1Name = Application.GetOpenFilename
If WB1Name = "False" Then
MsgBox "No File Selected. Quitting.", _
vbOKOnly + vbInformation, _
"File Select Cancelled by User"
Exit Sub
End If
Application.ScreenUpdating = False
'open the other workbook without updating links
'and in Read Only mode
Application.DisplayAlerts = False
Set WB1 = Workbooks.Open(WB1Name, False, True)
Application.DisplayAlerts = True
Set WS1 = WB1.Worksheets(1)
Set WS1NamesRange = WS1.Range(NameCol & "1:" & _
WS1.Range(NameCol & Rows.Count).End(xlUp).Address)
offset2InvNo = Range(InvNoCol & 1).Column - _
Range(NameCol & 1).Column
offset2Date = Range(InvDateCol & 1).Column - _
Range(NameCol & 1).Column

Set WB2 = ThisWorkbook
WB2.Activate
'begin the real work
For Each anyWS1Name In WS1NamesRange
Select Case UCase(Trim(anyWS1Name))
Case Is = ws1Name
'goes to sheet AA
'IF the date is today
If anyWS1Name.Offset(0, offset2Date) = Date Then
'now must make sure invoice number does no
'already exist in this workbook (WB2)
Set WB2WS = WB2.Worksheets(ws1Name)
Set WB2CurrentInvoices = WB2WS.Range(InvNoCol _
& "1:" & WB2WS.Range(InvNoCol _
& Rows.Count).End(xlUp).Address)
foundFlag = False
For Each anyWB2Invoice In WB2CurrentInvoices
If anyWB2Invoice = _
anyWS1Name.Offset(0, offset2InvNo) Then
foundFlag = True
Exit For
End If
Next
If Not foundFlag Then
'this is a new entry, make it!
Set sourceRange = WS1.Range(FirstColToCopy & _
anyWS1Name.Row & ":" _
& LastColToCopy & anyWS1Name.Row)
nextWB2Row = WB2WS.Range(FirstColToCopy & _
Rows.Count).End(xlUp).Row + 1
Set destRange = WB2WS.Range(FirstColToCopy & _
nextWB2Row & ":" _
& LastColToCopy & nextWB2Row)
destRange.Value = sourceRange.Value
End If
End If

Case Is = ws2Name
'goes to sheet BB
'IF the date is today
If anyWS1Name.Offset(0, offset2Date) = Date Then
Set WB2WS = WB2.Worksheets(ws2Name)
Set WB2CurrentInvoices = WB2WS.Range(InvNoCol _
& "1:" & WB2WS.Range(InvNoCol _
& Rows.Count).End(xlUp).Address)
foundFlag = False
For Each anyWB2Invoice In WB2CurrentInvoices
If anyWB2Invoice = _
anyWS1Name.Offset(0, offset2InvNo) Then
foundFlag = True
Exit For
End If
Next
If Not foundFlag Then
'this is a new entry, make it!
Set sourceRange = WS1.Range(FirstColToCopy & _
anyWS1Name.Row & ":" _
& LastColToCopy & anyWS1Name.Row)
nextWB2Row = WB2WS.Range(FirstColToCopy & _
Rows.Count).End(xlUp).Row + 1
Set destRange = WB2WS.Range(FirstColToCopy & _
nextWB2Row & ":" _
& LastColToCopy & nextWB2Row)
destRange.Value = sourceRange.Value
End If
End If

Case Else
'do nothing
End Select
Next
'cleanup and finish
Set sourceRange = Nothing
Set destRange = Nothing
Set WS1 = Nothing
WB1.Close False ' close without saving changes
Set WB1 = Nothing
Set WB2 = Nothing
MsgBox "New Invoice Copying Completed.", _
vbOKOnly + vbInformation, "Task Completed"
End Sub


"Seeker" wrote:

Need help in following VBA
Wb 2 sheets named as €œAA€� & €œBB€�.
Wb1, Sheet 1, col E = date, col D = InvoiceNo, col B = Names,
I need to copy wb1 range col D to col K of row(s) found which col B are €œAA€�
& €œBB€� only and col E = today and col D (InvoiceNo) not a duplication in wb2.
When transfer data from wb1 to wb2, place in the sheet with same name as col
B.
Tks & Rgds