Second shot on explaining add to database if not in there

[Djblois]

I tried this once before. I am creating a macro that will add customer name, product name, etc... to each line of a spreadsheet (off of our systems generated report.) However we are always adding new customers and products so I want it to add back to my original database. Here is a more detailed explanation:

First, I create a customer and a product tab off of the report using this code.
'Create Product tab
Set rngFind = Detail.Range("A:A").Find(What:="Product:", After:=Detail.Range("A1"))
Detail.Range(rngFind, Detail.Cells(Detail.Rows.Count, rngFind.Column)).Cut
If WB.Sheets.Count = 1 Then
Set Prod = WB.Worksheets.Add
Else
Set Prod = WB.Worksheets(2)
Prod.Activate
End If

ActiveSheet.Name = "Prod"
ActiveSheet.Paste

Set C = Columns("A:A").Find(What:="Ship-To:")
If C Is Nothing Then
GoTo Item
Else
ShipTo
End If
Set C = Nothing

Item:

'Remove ) from Data
Prod.Columns("A:B").Replace What:=")", Replacement:=""
'Create Item# Column in product tab
Prod.Range("B1:B" & Prod.Cells(Prod.Rows.Count, 1).End(xlUp).Row). _
FormulaR1C1 = "=Mid(RC[-1],10,6)"
Prod.Range("B1:B" & Prod.Cells(Prod.Rows.Count, 1).End(xlUp).Row).Value = _
Prod.Range("B1:B" & Prod.Cells(Prod.Rows.Count, 1).End(xlUp).Row).Value

'Create Products Column in product tab
Prod.Range("C1:C" & Prod.Cells(Prod.Rows.Count, 1).End(xlUp).Row). _
FormulaR1C1 = "=PROPER(Trim(MID(RC[-2],18,80)))"
Prod.Range("C1:C" & Prod.Cells(Prod.Rows.Count, 1).End(xlUp).Row).Value = _
Prod.Range("C1:C" & Prod.Cells(Prod.Rows.Count, 1).End(xlUp).Row).Value


Then, I open a database that I maintain with customers and products. (Which is never complete because we are always adding more. Using this code:

Dim Codes As Workbook, WasCodesOpen As Boolean
On Error Resume Next
Set Codes = Workbooks("Atalanta Codes.xls")
WasCodesOpen = True
On Error GoTo 0
If Codes Is Nothing Then
Set Codes = Workbooks.Open("H:\@temp\Daniel B\Reference\Atalanta Codes.xls")
WasCodesOpen = False
End If
WB.Activate

finally, I use a vlookup on the database first which is Atalanta Codes (because I have cleaned those names up and are more presentable) Then it looks in the Customer or product sheet using this code:

'Fix Cust# (D)
Detail.Range("D1").FormulaR1C1 = "Cust#"
Detail.Columns("D:D").TextToColumns Destination:=Range("D1")

'Add Customers (E)
Detail.Columns("E:E").Insert Shift:=xlToRight
Detail.Range("E1").FormulaR1C1 = "Customer"
Detail.Range("E2:E" & Detail.Cells(Detail.Rows.Count, 1).End(xlUp).Row).FormulaR1C1 = _
"=IF(ISNA(VLOOKUP(RC[-1],'[Atalanta Codes.xls]Cust'!C1:C9,2,FALSE)), _
VLOOKUP(RC[-1],Cust!C[-3]:C[-2],2,FALSE), _
VLOOKUP(Detail!RC[-1],'[Atalanta Codes.xls]Cust'!C1:C9,2,FALSE))"
Detail.Range("E1:E" & Detail.Cells(Detail.Rows.Count, 1).End(xlUp).Row).Value = _
Detail.Range("E1:E" & Detail.Cells(Detail.Rows.Count, 1).End(xlUp).Row).Value
'.Progress 200

Then, I would like to add whatever it added from the product or customer worksheets into my database. (only if it added from their, since their will be duplicated between the two.

[mdmackillop]

Can you please add linebreaks to your code to remove the need to scroll

[Djblois]

sorry, I have a wide screen I didn't notice

[mdmackillop]

Can you not use the Match function to ascertain unique values and then filter results to the other workbook.

BTW to tidy thing up, try

Set ProdB = Prod.Range("B1:B" & Prod.Cells(Prod.Rows.Count, 1).End(xlUp).Row)
With ProdB
.FormulaR1C1 = "=Mid(RC[-1],10,6)"
.Value = .Value
End With
Set ProdB = Nothing

[Djblois]

I guess I could but I don't know how I would code that? I guess you would call me a beginner power user? lol

[mdmackillop]

Have a look at this

[Djblois]

mdmack,

It works perfectly in your database however, here is the code I am using now

Option Explicit
Public wb As Workbook, Detail As Worksheet, Cust As Worksheet, Prod As Worksheet
Public rngFind As Range, MyInput As String, C As Range, d As Range
Public s As Range, e As Workbook, cel, Tmp As Long
Public Codes As Workbook, WasCodesOpen As Boolean
'Open Atalanta Codes workbook
On Error Resume Next
Set Codes = Workbooks("Atalanta Codes.xls")
WasCodesOpen = True
On Error GoTo 0
If Codes Is Nothing Then
Set Codes = Workbooks.Open("H:\@temp\Daniel B\Reference\Atalanta Codes.xls")
WasCodesOpen = False
End If
wb.Activate

Codes.Sheets("Cust").Activate
e = Sheets("Cust").Range([A3], [A3].End(xlDown)).Value
wb.Activate
Set s = Cust.Range([B1], [B1].End(xlDown))
For Each cel In s
On Error Resume Next
Tmp = Application.WorksheetFunction.Match(cel, e, 0)
If Err = 1004 _
Then cel.Range("A1:C1").Copy Workbooks.Codes.Sheets.e.[A65536].End(xlUp).Offset(1)
Err.Clear
Next

It keeps giving me an error on the line:

If Err = 1004 _
Then cel.Range("A1:C1").Copy Workbooks.Codes.Sheets.e.[A65536].End(xlUp).Offset(1)


The error I get is Compile Error:
Method or Data member not found

[mdmackillop]

You have declared e as a workbook, then set it as a array of values.
Codes is also Dimmed as a workbook. Once set, it does not need the WorkBooks description.
This code
Workbooks.Codes.Sheets.e.[A65536].End(xlUp).Offset(1)
is saying something like
Copy some data to a Workbook named WorkBook.Something and in a Sheet called after an array of cells and insert the value in the last cell in the row.
I'm not clear about source and destination

Source: What is the name of the Source Workbook and Sheet name? What variables are you assigning to each?

Destination: What is the name of the Destination Workbook and Sheet name? What variables are you assigning to each?

[Djblois]

the Source Worksheet is always different in name (based on user input) and I declared it the variable wb and the sheet is always Cust and declared Cust also.

The Destination is Atalanta Codes and I declare it Codes. and the tab is also Cust but I don't declare it.

Here is the new code fixed up a little:

Codes.Sheets("Cust").Activate
e = Sheets("Cust").Range([A3], [A3].End(xlDown)).Value
wb.Activate
Set s = Cust.Range([B1], [B1].End(xlDown))
For Each cel In s
On Error Resume Next
Tmp = Application.WorksheetFunction.Match(cel, e, 0)
If Err = 1004 Then cel.Range("A1:C1").Copy Codes.e.[A65536].End(xlUp).Offset(1)
Err.Clear
Next

[Djblois]

Please help,

After I fix this in my code I will release 1.7 of my code to my company!!!

Daniel

[mdmackillop]

Hi Daniel
Use it as a separate sub and call it passing the wb variable.


Sub CopyInfo(wb As Workbook)
Dim Codes As String, Pth As String
Dim Chk As Workbook
Pth = "H:\@temp\Daniel B\Reference\"
Codes = "Atalanta Codes.xls"
On Error Resume Next
Set Chk = Workbooks(Codes)
If Err = 9 Then Workbooks.Open Pth & Codes
Err.Clear
Set e = Workbooks(Codes).Sheets("Cust").Range([A3], [A3].End(xlDown))
wb.Activate
Set s = Sheets("Cust").Range([B1], [B1].End(xlDown))
For Each cel In s
On Error Resume Next
Tmp = Application.WorksheetFunction.Match(cel, e, 0)
If Err = 1004 _
Then cel.Range("A1:C1").Copy _
Workbooks(Codes).Sheets("Cust").[A65536].End(xlUp).Offset(1)
Err.Clear
Next
End Sub

[mdmackillop]

BTW, Did you read this thread?
http://vbaexpress.com/forum/showthread.php?t=8642

[Djblois]

mdmack,

it is giving me a type mismatch error on this line:

Set e = Workbooks(Codes).Sheets("Cust").Range([A1], [A1].End(xlDown))

[mdmackillop]

Try adding .value at the end of the line

[Djblois]

I added the .Value to the end and it is still giving me a type mismatch error

[mdmackillop]

Hi Daniel,
I think I found the bug. I've reset my example as close as I can to yours, as I understand it. Changing the variable values should be all that is required. I hope this solves your problem as I'm off for two weeks vacation, :cloud9: and visits here will be few (if any)
Regards
MD