Excel VBA Consolidate Range

K

kashif.special2005

Active Member
Joined
Oct 26, 2009
Messages
443
Hi,

I have data of previous month and current month, now I want to compare both months data with unique EmpID, and if the EmpID of current month's data is matched from Previous months EmpID then update the column with the current months data, and if the empID of current month's data is not exists in Previous months then simply add those details in previous months data, and also create two columns "EmpID" and "Columns Changed" in new sheets, with the changed columns detail.

Please find the data below of Previous month's, current month.

Previous Month Data


Sheet1

ABCDE
1EmpIDProjectRegionWithout DemandEfficiency
21AEastTRUEYes
32BWest Yes
43CNorthFALSENo
54DSouth No
65EEast No
76FWestTRUENo
87GNorth Yes
98HSouthFALSEYes
109IEast Yes
1110JNorthTRUENo

<colgroup><col style="font-weight:bold; width:30px; "><col style="width:64px;"><col style="width:64px;"><col style="width:64px;"><col style="width:114px;"><col style="width:64px;"></colgroup><tbody>
</tbody>


Excel tables to the web >> Excel Jeanie HTML 4

Current Month Data


Sheet1

IJKLM
1EmpIDProjectRegionWithout DemandEfficiency
21BNorthFALSEYes
32BWest No
47ASouthTRUEYes
58HSouthFALSENo
610JEastTRUENo
711GSouthFALSENo
812HNorthTRUEYes
913KSouthTRUENo
1014LEastFALSEYes

<colgroup><col style="font-weight:bold; width:30px; "><col style="width:64px;"><col style="width:64px;"><col style="width:64px;"><col style="width:64px;"><col style="width:64px;"></colgroup><tbody>
</tbody>


Excel tables to the web >> Excel Jeanie HTML 4

1st output will be like below image

Sheet1

ABCDE
16EmpIDProjectRegionWithout DemandEfficiency
171BNorthFALSEYes
182BWest No
193CNorthFALSENo
204DSouth No
215EEast No
226FWestTRUENo
237ASouthTRUEYes
248HSouthFALSENo
259IEast Yes
2610JEastTRUENo
2711GSouthFALSENo
2812HNorthTRUEYes
2913KSouthTRUENo
3014LEastFALSEYes

<colgroup><col style="font-weight:bold; width:30px; "><col style="width:64px;"><col style="width:64px;"><col style="width:64px;"><col style="width:114px;"><col style="width:64px;"></colgroup><tbody>
</tbody>


Excel tables to the web >> Excel Jeanie HTML 4

2nd result will be like below.

Sheet1

HI
15EmpIDChanged Column
161Project,Region,Without Demand
172Efficiency
187Project,Region,Without Demand
198Efficiency
2010Region

<colgroup><col style="font-weight:bold; width:30px; "><col style="width:64px;"><col style="width:213px;"></colgroup><tbody>
</tbody>


Excel tables to the web >> Excel Jeanie HTML 4

Note:- The problem is that, the data is huge like 5000 rows and 65 columns, I showed above just random sample data.


I don't know how can I compare such a large rows and columns data row by row and update those columns only that's value have changed.


Please, please help me to achieve this task


Thanks
Kashif
 
Last edited:

Excel Facts

Copy a format multiple times
Select a formatted range. Double-click the Format Painter (left side of Home tab). You can paste formatting multiple times. Esc to stop
Sort by date Sort by votes
Try this:-
NB:- This code is based on the data you show and the Addresses you specify, except that as the "Current Month" and the "Previous Month" can't exist on the same sheet in the same place I have Placed the "Current Month" on sheet2.
The results will show in the additions/Modifications in sheet 1 "Previous Month".
With the Results of any changes in column "F" of sheet1.
If this results conflicts with your data layout, you will need to specify the actual layout of your data, how the code results can be incorporated.
Code: 
[COLOR="Navy"]Sub[/COLOR] MG30Sep50
[COLOR="Navy"]Dim[/COLOR] Rng1 [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Rng2 [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] nStr [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String,[/COLOR] c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Dic [COLOR="Navy"]As[/COLOR] Object
[COLOR="Navy"]With[/COLOR] Sheets("Sheet1")
    [COLOR="Navy"]Set[/COLOR] Rng1 = .Range(.Range("A2"), .Range("A" & Rows.Count).End(xlUp))
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]Set[/COLOR] Dic = CreateObject("scripting.dictionary")
Dic.CompareMode = vbTextCompare

[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng1
    [COLOR="Navy"]If[/COLOR] Not Dic.exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
        Dic.Add Dn.Value, Array(Dn.Offset(, 1), Dn.Offset(, 2), Dn.Offset(, 3), Dn.Offset(, 4))
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]
[COLOR="Navy"]With[/COLOR] Sheets("Sheet2")
    [COLOR="Navy"]Set[/COLOR] Rng2 = .Range(.Range("A2"), .Range("A" & Rows.Count).End(xlUp))
[COLOR="Navy"]End[/COLOR] With
c = Rng1.Count + 1
[COLOR="Navy"]With[/COLOR] Sheets("Sheet1")
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng2
    [COLOR="Navy"]If[/COLOR] Not Dic.exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
        c = c + 1
        .Cells(c, 1).Resize(, 5).Value = Application.Transpose(Application.Transpose(Dn.Resize(, 5).Value))
    [COLOR="Navy"]Else[/COLOR]
        [COLOR="Navy"]For[/COLOR] n = 1 To 4
            [COLOR="Navy"]If[/COLOR] Not Dn.Offset(, n).Value = Dic(Dn.Value)(n - 1) [COLOR="Navy"]Then[/COLOR]
                nStr = nStr & IIf(nStr = "", .Cells(1, Dn.Offset(, n).Column), ", " & .Cells(1, Dn.Offset(, n).Column))
            [COLOR="Navy"]End[/COLOR] If
        [COLOR="Navy"]Next[/COLOR] n
            Dic(Dn.Value)(0).Offset(, 4) = nStr
            nStr = ""
            Dic(Dn.Value)(0).Offset(, -1).Resize(, 5).Value = Application.Transpose(Application.Transpose(Dn.Resize(, 5).Value))
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
Hi MickG,

It works like a fly, thank you, thank you so mcuh, 1000 time thank you so much, you don't know how much you helped me God bless you.

How easily, you have done this, first time I heard about "Dictionary" in VBA, I want to learn more about "Dictionary" thing in VBA, it would be great help if you will guide me, where and I how can I learn all about "Dictionary" this in VBA.

Once again thank you so much for your precious time.

Thanks
Kashif
 
Upvote 0
Hi MickG,

I have one question here regarding the line

Dic.Add Dn.Value, Array(Dn.Offset(, 1), Dn.Offset(, 2), Dn.Offset(, 3), Dn.Offset(, 4))

I have just put 4 columns in the example above, however actually it is around 60 to 70 columns, so my question is that I will have to put manually 60 offset in above line?

If so it is manually thing and suppose in future columns reduce than I have to put less offset in above code, can it not be dynamically.

If it would be dynamically, it would be great help.

Thanks
Kashif
 
Last edited:
Upvote 0
You're welcome
Relating to "Dictionaries, see here:-
http://www.snb-vba.eu/VBA_Dictionary_en.html

Relating to Post#4
You need to show the basic outline of your data, clarifying :-

NB:- These questions are related to Both sheet1 & sheet2 Data !!!!
Q1) Are the the first 5 columns as already shown in the thread in the correct columns.
Q2) Approx How many columns are there
Q3) Do all the rows have the same number of columns.
Q4) At the moment the result of mismatches are shown in column "F" , is that column empty on the basic data or do you need to place the mismatched data somewhere else.
Q5) If so where ????
Q6) I am assuming from Post 4 that you require all of the columns (not just 5) in sheet 2 to be transferred to sheet1 as and when required. Is that correct ???
 
Upvote 0
Hi MickG,

Thanks for reply,

Please find below the response of your questions.

Q1-Answer:- Yes
Q2-Answer:- Around 66
Q3-Answer:- Yes
Q4-Answer:- No it is fine that mismatched columns headings are showing in column F with comma like :- "Project, Region, Without Demand", it is absolutely fine
Q5:- No

Q6-Answer:- Yes

I hope, I gave all the answers you required.

Thanks
Kashif
 
Upvote 0
Try this:-
Nb The number of columns used, is based on sheet2 row1 data (Count)
Code: 
[COLOR="Navy"]Sub[/COLOR] MG01Oct51
[COLOR="Navy"]Dim[/COLOR] Rng1 [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Rng2 [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] nStr [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String,[/COLOR] c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Dic [COLOR="Navy"]As[/COLOR] Object, Lst [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]With[/COLOR] Sheets("Sheet1")
    [COLOR="Navy"]Set[/COLOR] Rng1 = .Range(.Range("A2"), .Range("A" & Rows.Count).End(xlUp))
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]Set[/COLOR] Dic = CreateObject("scripting.dictionary")
Dic.CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng1
    [COLOR="Navy"]If[/COLOR] Not Dic.exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
        Dic.Add Dn.Value, Array(Dn.Offset(, 1), Dn.Offset(, 2), Dn.Offset(, 3), Dn.Offset(, 4))
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]
[COLOR="Navy"]With[/COLOR] Sheets("Sheet2")
    [COLOR="Navy"]Set[/COLOR] Rng2 = .Range(.Range("A2"), .Range("A" & Rows.Count).End(xlUp))
    Lst = .Cells("1", Columns.Count).End(xlToLeft).Column
[COLOR="Navy"]End[/COLOR] With
c = Rng1.Count + 1
[COLOR="Navy"]With[/COLOR] Sheets("Sheet1")
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng2
    [COLOR="Navy"]If[/COLOR] Not Dic.exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
        c = c + 1
        .Cells(c, 1).Resize(, Lst).Value = Application.Transpose(Application.Transpose(Dn.Resize(, Lst).Value))
    [COLOR="Navy"]Else[/COLOR]
        [COLOR="Navy"]For[/COLOR] n = 1 To 4
            [COLOR="Navy"]If[/COLOR] Not Dn.Offset(, n).Value = Dic(Dn.Value)(n - 1) [COLOR="Navy"]Then[/COLOR]
                nStr = nStr & IIf(nStr = "", .Cells(1, Dn.Offset(, n).Column), ", " & .Cells(1, Dn.Offset(, n).Column))
            [COLOR="Navy"]End[/COLOR] If
        [COLOR="Navy"]Next[/COLOR] n
            
            Dic(Dn.Value)(0).Offset(, -1).Resize(, Lst).Value = Application.Transpose(Application.Transpose(Dn.Resize(, Lst).Value))
            Dic(Dn.Value)(0).Offset(, 4) = nStr
            nStr = ""
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
Hi MickG,

Thanks for reply, my concern is for this below line, here we are manually putting 4 columns from sheet1, however sheet1 and sheet2 has same columns 66, so the problem is that I have to put 66 offset in below line, could it not be dynamic, if yes, please help, how can I achieve that

Dic.Add Dn.Value, Array(Dn.Offset(, 1), Dn.Offset(, 2), Dn.Offset(, 3), Dn.Offset(, 4))

Note:- Previous month's and current months data have same column and that is 66.

Please reply, if you have any doubt.

Thanks
Kashif
 
Upvote 0
Hi MickG,

As per my understanding, you are putting four columns value in Dictionary, but I have around 66 columns, so my question is that how can I store 66 columns value of a row in dictionary, I will use "offset" method, it will be really hard to put 66 offset and store in dictionary, could we not use array here, if yes please help me how can we do this.

For Each Dn In Rng1
If Not Dic.exists(Dn.Value) Then
Dic.Add Dn.Value, Array(Dn.Offset(, 1), Dn.Offset(, 2), Dn.Offset(, 3), Dn.Offset(, 4))
End If
Next
Thanks
Kashif
 
Last edited:
Upvote 0
You must log in or register to reply here.

Similar threads

E
  • Question
Adding a custom message.
Replies
1
Views
446
Micron
M
N
  • Question
2-step Dynamic Ranges and Charts
Replies
0
Views
246
Nick Loughton
N
C
  • Solved
Excel 2016 32bit VBA Pulling info from Website to Sheet
Replies
2
Views
1K
CrashOD
C
L
  • Solved
Would like to make edits to VBA Calendar Code
Replies
8
Views
434
Legacy 352679
L
A
  • Solved
Calendar form cancel button passing data to worksheet
Replies
7
Views
451
AndyEd
A

Forum statistics

Threads
1,215,455
Messages
6,124,935
Members
449,195
Latest member
Stevenciu

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