Copy from one worksheet to another based on cell value...

C

chefdt

Board Regular
Joined
Jul 1, 2008
Messages
163
I've been away from this for awhile. Seems straightforward, but I just can't get it. I have a single worksheet in a workbook named "export.xls" It looks like this.
[TABLE="width: 492"]
<colgroup><col span="5"><col><col></colgroup><tbody>[TR]
[TD="align: right"][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"][/TD]
[/TR]
[TR]
[TD][TABLE="width: 588"]
<colgroup><col><col><col><col><col><col><col></colgroup><tbody>[TR]
[TD]SUPC[/TD]
[TD]Pack[/TD]
[TD]Size[/TD]
[TD]Brand[/TD]
[TD]Desc[/TD]
[TD]Cat[/TD]
[TD]Case $[/TD]
[/TR]
[TR]
[TD="align: right"]8965881[/TD]
[TD="align: right"]9[/TD]
[TD].5 GAL[/TD]
[TD]WHLFARM[/TD]
[TD]BUTTERMILK FRESH 1%[/TD]
[TD]Dairy Products[/TD]
[TD="align: right"]22.58[/TD]
[/TR]
[TR]
[TD="align: right"]6697890[/TD]
[TD="align: right"]4[/TD]
[TD]5 LB[/TD]
[TD]BBRLCLS[/TD]
[TD]CHEESE AMER YEL 160 SLI
[/TD]
[TD]Dairy Products[/TD]
[TD="align: right"]43.99[/TD]
[/TR]
[TR]
[TD="align: right"]2599793[/TD]
[TD="align: right"]1[/TD]
[TD]10 LB[/TD]
[TD]BBRLIMP[/TD]
[TD]CHEESE CHDR MILD YEL PRNT[/TD]
[TD]Dairy Products[/TD]
[TD="align: right"]25.69[/TD]
[/TR]
[TR]
[TD="align: right"]7950876[/TD]
[TD="align: right"]1[/TD]
[TD]15 LB[/TD]
[TD]SYS REL[/TD]
[TD]BACON LAYFLAT 18/22 HRTY SMOKE[/TD]
[TD]Meats[/TD]
[TD="align: right"]54.5[/TD]
[/TR]
[TR]
[TD="align: right"]6748760[/TD]
[TD="align: right"]2[/TD]
[TD]7-8#AV[/TD]
[TD]HLSHIRE[/TD]
[TD]BEEF CORNED BRSKT CH CKD FZ[/TD]
[TD]Meats[/TD]
[TD="align: right"]2.3337[/TD]
[/TR]
[TR]
[TD="align: right"]1044445[/TD]
[TD="align: right"]40[/TD]
[TD]4 OZ[/TD]
[TD]SYS IMP[/TD]
[TD]BEEF FRITTER CHKN CNTRY FRIED[/TD]
[TD]Meats[/TD]
[TD="align: right"]46.29[/TD]
[/TR]
[TR]
[TD="align: right"]793434[/TD]
[TD="align: right"]1[/TD]
[TD]10 LB[/TD]
[TD]ICYBAY[/TD]
[TD]FLOUNDER FILLET FZN 4 OZ[/TD]
[TD]Seafood[/TD]
[TD="align: right"]43.68[/TD]
[/TR]
[TR]
[TD="align: right"]6731515[/TD]
[TD="align: right"]4[/TD]
[TD]2.5 LB[/TD]
[TD]PORTBTY[/TD]
[TD]SHRIMP WHT P&D TLON 26/30[/TD]
[TD]Seafood[/TD]
[TD="align: right"]93.07[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[TD="align: right"][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"][/TD]
[/TR]
</tbody>[/TABLE]

I have a second workbook (inventory.xls) setup with worksheets named to match the column labeled "CAT". I need help with a macro that will import the data from the closed workbook (export.xls) and copy all rows into the open workbook, placing each row into the appropriate worksheet matching the CAT column.

Additionally I would like to scan for duplicate (SUPC) values as it pastes the row and do the following;
1. If the item already exists, only copy the (CASE $) field and highlite it somehow as a new price
2. If the item does not exist, copy the entire row to the bottom row

Any help you all can give me would be great.

DT
 

Excel Facts

Which lookup functions find a value equal or greater than the lookup value?
MATCH uses -1 to find larger value (lookup table must be sorted ZA). XLOOKUP uses 1 to find values greater and does not need to be sorted.
Sort by date Sort by votes
I wrote this code assuming your data starts in A1. Let me know if this works for you
Code: 
Sub BeardedMeatFlap()
    Application.ScreenUpdating = False
    Dim export As Workbook: Set export = Workbooks("export.xls")
    Dim inventory As Workbook: Set inventory = Workbooks("inventory.xls")
    Dim cell As Range, cell2 As Range
    Dim CatName As String
    For Each cell In Range(Range("A2"), Range("A2").End(xlDown)) 'Adjust this line based on where your data starts
        CatName = Cells(cell.Row, "F")
        Range(cell, cell.End(xlToRight)).Copy
        inventory.Sheets(CatName).Activate
        Cells(Cells.Rows.Count, 1).End(xlUp).Offset(1, 0).Select
        ActiveSheet.Paste
        For Each cell2 In Range(Range("A1"), ActiveCell)
            If cell2 = ActiveCell And cell2.Address <> ActiveCell.Address Then
                Range(ActiveCell, Cells(ActiveCell.Row, "F")).ClearContents
                Cells(ActiveCell.Row, "G").Interior.Color = vbYellow
                Exit For
            End If
        Next cell2
        export.Activate
    Next cell
    Application.ScreenUpdating = True
    Application.CutCopyMode = False
End Sub
 
Upvote 0
Dreadknight Nasus said:
I wrote this code assuming your data starts in A1. Let me know if this works for you
Code: 
Sub BeardedMeatFlap()
    Application.ScreenUpdating = False
    Dim export As Workbook: Set export = Workbooks("export.xls")
    Dim inventory As Workbook: Set inventory = Workbooks("inventory.xls")
    Dim cell As Range, cell2 As Range
    Dim CatName As String
    For Each cell In Range(Range("A2"), Range("A2").End(xlDown)) 'Adjust this line based on where your data starts
        CatName = Cells(cell.Row, "F")
        Range(cell, cell.End(xlToRight)).Copy
        inventory.Sheets(CatName).Activate
        Cells(Cells.Rows.Count, 1).End(xlUp).Offset(1, 0).Select
        ActiveSheet.Paste
        For Each cell2 In Range(Range("A1"), ActiveCell)
            If cell2 = ActiveCell And cell2.Address <> ActiveCell.Address Then
                Range(ActiveCell, Cells(ActiveCell.Row, "F")).ClearContents
                Cells(ActiveCell.Row, "G").Interior.Color = vbYellow
                Exit For
            End If
        Next cell2
        export.Activate
    Next cell
    Application.ScreenUpdating = True
    Application.CutCopyMode = False
End Sub
Click to expand...

Forgot to give you the format of inventory.xls I need the data arranged in same colums, with Case $ in column H

A=SUPC
B=Item Desc
C=Brand
D=Count
E=Pack
F=Mfg #
G=Re-order
H=Case Cost

Data begins in Row 8

DT
 
Last edited:
Upvote 0
Dreadknight Nasus said:
Is it necessary to use this code in Inventory.xlsm? Because I wrote it as if export.xlsm was the active workbook
Click to expand...

I'd like to run it with a button from the inventory.xls (main control) sheet, and maybe have export.xls residing in "c:\inventory\export.xlsm"

DT
 
Upvote 0
Okay, put this in a module in export.xlsm and run it. Let me know if it works.
Code: 
 Option Explicit
Sub BeardedMeatFlap()
    Application.ScreenUpdating = False
    Dim export As Workbook: Set export = Workbooks("export.xlsm")
    Dim inventory As Workbook: Set inventory = Workbooks("Inventory.xlsm")
    Dim cell As Range, cell2 As Range
    Dim CatName As String
    For Each cell In Range(Range("A2"), Range("A2").End(xlDown))
        CatName = Cells(cell.Row, "F")
        cell.Copy
        inventory.Sheets(CatName).Activate
        Cells(Cells.Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
        export.Activate
        Cells(cell.Row, 2).Copy
        inventory.Sheets(CatName).Activate
        Cells(Cells.Rows.Count, 4).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
        export.Activate
        Cells(cell.Row, 3).Copy
        inventory.Sheets(CatName).Activate
        Cells(Cells.Rows.Count, 5).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
        export.Activate
        Cells(cell.Row, 4).Copy
        inventory.Sheets(CatName).Activate
        Cells(Cells.Rows.Count, 3).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
        export.Activate
        Cells(cell.Row, 5).Copy
        inventory.Sheets(CatName).Activate
        Cells(Cells.Rows.Count, 2).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
        export.Activate
        Cells(cell.Row, 7).Copy
        inventory.Sheets(CatName).Activate
        Cells(ActiveCell.Row, 8).PasteSpecial Paste:=xlPasteValues
        
        For Each cell2 In Range(Range("A8"), Cells(ActiveCell.Row, 1))
            If cell2 = Cells(ActiveCell.Row, 1) And cell2.Address <> Cells(ActiveCell.Row, 1).Address Then
                Range(Cells(ActiveCell.Row, 1), Cells(ActiveCell.Row, "G")).ClearContents
                Cells(ActiveCell.Row, "H").Interior.Color = vbYellow
                Exit For
            End If
        Next cell2
        export.Activate
    Next cell
    Application.ScreenUpdating = True
    Application.CutCopyMode = False
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

M
  • Question Question
Excel VBA, Copy data from one sheet to another workbook and sort data into multiple worksheets based on cell value
Replies
0
Views
917
mmurphy13
M
F
  • Question Question
Excel VBA. Copy and paste from one cell to another based on value.
Replies
0
Views
557
fellodan
F
M
  • Question Question
Return Multiple Cells From One Column From A Unique cell in another Column
Replies
7
Views
500
oldbrewer
O
J
  • Question Question
Auto fill group data using info from another worksheet based on multiple cells? - Formula Needed.
Replies
1
Views
1K
istiasztalos
I
M
  • Question Question
Copy row from one worksheet to another based on date (Expired Date)
Replies
4
Views
4K
My Aswer Is This
My Aswer Is This

Forum statistics

Threads
1,223,099
Messages
6,170,114
Members
452,302
Latest member
TaMere

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top