replacing old department data with new department data using VBA

[Mr2017]

Hi

I've got a sheet with data and the Department name in each row.

I'd like to replace data for a specific Department when I import data from a folder.

I've written the code to import the data. But I'd like to know if it's possible to write code that will search for a Department name in the worksheet I'm importing data into, then replace all rows that relate to that specific Department?

To illustrate, I've created a simple example below. It has two Departments - Chocolate and Cereals, over 5 rows.

There are TWO tabs - Sheet 1 and Sheet 2 - the only difference is the names and prices of products the Cereals in Sheet 2.

So is it possible to create code that OVER-WRITES the Cereals data, ONLY, in Sheet 1 (assuming that the new Cereals data has already been copied)?



Data for Sheet 1 (paste into cell A1)


[TABLE="width: 264"]
<colgroup><col><col><col></colgroup><tbody>[TR]
[TD]Department[/TD]
[TD]Product[/TD]
[TD]Price[/TD]
[/TR]
[TR]
[TD]Chocolate[/TD]
[TD]Choc 1[/TD]
[TD]1[/TD]
[/TR]
[TR]
[TD]Chocolate[/TD]
[TD]Choc2[/TD]
[TD]1[/TD]
[/TR]
[TR]
[TD]Cereal[/TD]
[TD]Cornflakes[/TD]
[TD]1[/TD]
[/TR]
[TR]
[TD]Cereal[/TD]
[TD]All Bran[/TD]
[TD]2[/TD]
[/TR]
[TR]
[TD]Cereal[/TD]
[TD]Oats Porridge[/TD]
[TD]1[/TD]
[/TR]
</tbody>[/TABLE]


Data for Sheet 2 (paste into cell A1 of Sheet 2)

[TABLE="width: 257"]
<colgroup><col><col><col></colgroup><tbody>[TR]
[TD]Department[/TD]
[TD]Product[/TD]
[TD]Price[/TD]
[/TR]
[TR]
[TD]Chocolate[/TD]
[TD]Choc 1[/TD]
[TD]1[/TD]
[/TR]
[TR]
[TD]Chocolate[/TD]
[TD]Choc2[/TD]
[TD]1[/TD]
[/TR]
[TR]
[TD]Cereal[/TD]
[TD]Muesli[/TD]
[TD]4[/TD]
[/TR]
[TR]
[TD]Cereal[/TD]
[TD]Lucky Charms[/TD]
[TD]5[/TD]
[/TR]
[TR]
[TD]Cereal[/TD]
[TD]Cheerios[/TD]
[TD]6[/TD]
[/TR]
</tbody>[/TABLE]


I've got code below which copies data from Sheet 2 then pastes it into Sheet 1. But I'd like to be able to replace specific Departments eg Cereals only or Chocolate only, when I've copied new data for that Department.

Thanks in advance

Sub replacementcode()


Sheet2.Activate
Range("A1").CurrentRegion.Copy


Sheet1.Activate
Range("A1").Activate
ActiveCell.PasteSpecial (xlPasteAll)
End Sub

 

[MickG]

Try this:-
NB:- Enter Product name in "InputBox" fror related data in sheet2 to be placed in sheet1.

[COLOR="Navy"]Sub[/COLOR] MG13Mar23
[COLOR="Navy"]Dim[/COLOR] Shts [COLOR="Navy"]As[/COLOR] Variant, R1 [COLOR="Navy"]As[/COLOR] Range, R2 [COLOR="Navy"]As[/COLOR] Range, MyProd [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String,[/COLOR] S [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Q [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare

MyProd = InputBox("Enter Product Name", "Name", "Type Product Name here")
Shts = Array("Sheet1", "Sheet2")
[COLOR="Navy"]For[/COLOR] S = 0 To 1
[COLOR="Navy"]With[/COLOR] Sheets(Shts(S))
[COLOR="Navy"]Set[/COLOR] Rng = .Range("A2", .Range("A" & Rows.Count).End(xlUp))
  [COLOR="Navy"]End[/COLOR] With
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
        [COLOR="Navy"]If[/COLOR] Not .exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
            [COLOR="Navy"]If[/COLOR] S = 0 [COLOR="Navy"]Then[/COLOR]
                [COLOR="Navy"]Set[/COLOR] R1 = Dn
            [COLOR="Navy"]Else[/COLOR]
                [COLOR="Navy"]Set[/COLOR] R2 = Dn
            [COLOR="Navy"]End[/COLOR] If
            .Add Dn.Value, Array(R1, R2)
        [COLOR="Navy"]Else[/COLOR]
            Q = .Item(Dn.Value)
            [COLOR="Navy"]If[/COLOR] S = 0 [COLOR="Navy"]Then[/COLOR]
                [COLOR="Navy"]If[/COLOR] Q(0) [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR]
                 [COLOR="Navy"]Set[/COLOR] Q(0) = Dn
                 [COLOR="Navy"]Else[/COLOR]
                 [COLOR="Navy"]Set[/COLOR] Q(0) = Union(Q(0), Dn)
                [COLOR="Navy"]End[/COLOR] If
            [COLOR="Navy"]Else[/COLOR]
                [COLOR="Navy"]If[/COLOR] Q(1) [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR]
                 [COLOR="Navy"]Set[/COLOR] Q(1) = Dn
                 [COLOR="Navy"]Else[/COLOR]
                 [COLOR="Navy"]Set[/COLOR] Q(1) = Union(Q(1), Dn)
                [COLOR="Navy"]End[/COLOR] If
            [COLOR="Navy"]End[/COLOR] If
            .Item(Dn.Value) = Q
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]Next[/COLOR] S
[COLOR="Navy"]If[/COLOR] .exists(MyProd) [COLOR="Navy"]Then[/COLOR]
    [COLOR="Navy"]If[/COLOR] .Item(MyProd)(0).Count = .Item(MyProd)(1).Count [COLOR="Navy"]Then[/COLOR]
        .Item(MyProd)(0).Offset(, 1).Resize(, 22).Value = .Item(MyProd)(1).Offset(, 1).Resize(, 22).Value
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Else[/COLOR]
    MsgBox "Product name Not Found"
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[Mr2017]

Ok, thanks for posting this, Mick - it works! Didn't know it would be this complicated (!), but I'll look into amending the code for my purposes.

I might have some questions about it later, when amending my code. But I'll let you know, if that's ok?

 

[MickG]

No problem
I've just noticed a "Typo".
The line below Shows Resize(,2), this is correct your code shows Resize(,22) ( two places, please correct).

        .Item(MyProd)(0).Offset(, 1).[COLOR="#FF0000"]Resize(, 2).Value [/COLOR]= .Item(MyProd)(1).Offset(, 1).[COLOR="#FF0000"]Resize(, 2).Value[/COLOR]

 

[Mr2017]

Ok, thanks.

 

[Mr2017]

Hi Mick

I've got a couple of quick questions.

How would you modify the code with the following conditions:

1) the data to be copied will come from a file in the downloads folder, so only one sheet in the file that the data is being imported to would need to be referenced - so if the current array consists of Sheet 1 and Sheet 2, how would it change?

2) there are over two dozen columns (rather than 3) in the real data - so would this code work regardless of the number of columns that you're importing?

Thanks in advance.

 

[MickG]

I'm not sure what this means. ???
Are you saying you want to import 2 set of data to check against sheet1. ???
In this case a modification to the code is required.

1) the data to be copied will come from a file in the downloads folder, so only one sheet in the file that the data is being imported to would need to be referenced - so if the current array consists of Sheet 1 and Sheet 2, how would it change?

2) there are over two dozen columns (rather than 3) in the real data - so would this code work regardless of the number of columns that you're importing

Ans:- No, the code would need to be modified. You would need to supply a basic example of your multicolumn data .

 

[Mr2017]

Hi Mick

Thanks for the prompt response.

I'm making some changes to the code, but will send you a sample of the multi-column data later.

Thanks again.

 

[MickG]

Please continue your post in this thread :-

Why does the data on sheet1 and sheet 3 of "CCT.xlms" not appear to be starting in the same column, I was assuming the "Product ID" is in column "B"
Ref:-

The CTT file imports data from Sheet 1 of “Promotions – Cereals” (for example) into cell A8 of Sheet 3 AND cell B3 of Sheet 1 of the CTT Report (using a macro).

My code to transfer data from sheet3 "Promotions---" to sheet "CCT" assumes the groups of data on all sheets relating to your "Input" selection are all the same size (for each selected ID), are each a contiguous group, but not necessarily in the same row, is that correct???

 

[MickG]

Having just seen you second PM, can I take it that the code shown superseded you original requirement and your happy to just cut and paste the data from sheet "Promo--" to sheets "CCT".