Djblois
07-17-2006, 09:58 AM
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.
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.