replacing old department data with new department data using VBA

Mr2017

Well-known Member
Joined
Nov 28, 2016
Messages
644
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
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)


DepartmentProductPrice
ChocolateChoc 11
ChocolateChoc21
CerealCornflakes1
CerealAll Bran2
CerealOats Porridge1

<colgroup><col><col><col></colgroup><tbody>
</tbody>


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

DepartmentProductPrice
ChocolateChoc 11
ChocolateChoc21
CerealMuesli4
CerealLucky Charms5
CerealCheerios6

<colgroup><col><col><col></colgroup><tbody>
</tbody>


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

Code:
Sub replacementcode()


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


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

Excel Facts

Select all contiguous cells
Pressing Ctrl+* (asterisk) will select the "current region" - all contiguous cells in all directions.
Try this:-
NB:- Enter Product name in "InputBox" fror related data in sheet2 to be placed in sheet1.
Code:
[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
 
Upvote 0
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?
 
Last edited:
Upvote 0
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).

Code:
        .Item(MyProd)(0).Offset(, 1).[COLOR="#FF0000"]Resize(, 2).Value [/COLOR]= .Item(MyProd)(1).Offset(, 1).[COLOR="#FF0000"]Resize(, 2).Value[/COLOR]
 
Upvote 0
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.
 
Upvote 0
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 .
 
Last edited:
Upvote 0
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.
 
Upvote 0
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???
 
Last edited:
Upvote 0
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".
 
Upvote 0

Forum statistics

Threads
1,214,593
Messages
6,120,435
Members
448,961
Latest member
nzskater

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