Copying data from 3 different sheets to Master sheet

[chssundeep]

Hi Friends,

I have a problem in preparing Master sheet....

I have 4 sheets

1) SD
2) PG
3) MIN
4) Master

I have data in 3 sheets i.e SD,PG,MIN

Have to extract the data from 3 Columns i.e. ID, Group and Name from all the 3 sheets. In SD sheets there are 10 Rows, PG 6 Rows, MIN 8 Rows... All are having same heads i.e ID no, Group, Name but at different columns..

Now I need all the data in Master sheet under these 3 heads.....

Problem here is I update the data regularly in each sheet.....I should have a formula so that whenever I update in any of the 3 sheets it should automatically get updated in the Master sheet....


Previously one member from here had given a Fantastic solution to the same problem using vba code...Below is that

Option Explicit
Private Sub Worksheet_Activate()
Dim ws As Worksheet
[a4:C80].ClearContents

    For Each ws In Sheets(Array("SD", "PG", "MIN"))
        ws.[a4:C20].Copy Sheet4.Range("A65536").End(xlUp)(2)
    Next ws
End Sub

But the code is working when Heads i.e. ID, Name and Group are in same columns....

Now please help me in updating this code

Attached the Sample File and Previous solution files here....

 

[Chihiro]

It would be something like below.

Option Explicit
Private Sub Worksheet_Activate()
Dim ws As Worksheet
Dim c As Range
Dim lRow As Long
lRow = Cells(Rows.Count, 1).End(xlUp).Row
If lRow > 3 Then
    Range("A4:C" & lRow).ClearContents
End If

For Each ws In Sheets(Array("SD", "PG", "MIN"))
    With ws.Cells
        Set c = .Find("ID", After:=Cells(1), LookIn:=xlValues, Lookat:=xlWhole, _
            SearchOrder:=xlByColumns, MatchCase:=True)
        If Not c Is Nothing Then
            lRow = ws.Cells(Rows.Count, c.Column).End(xlUp).Row
            ws.Range(ws.Cells(c.Row + 1, c.Column), ws.Cells(lRow, c.Column + 2)).Copy _
            Sheets("Master").Range("A65536").End(xlUp)(2)
        End If
    End With
Next ws
End Sub

 

[chssundeep]

Dear Chihiro,

Thanks for the code....

I know nothing about VBA sorry for basic questions....

1. When trying to run with this code i am ending up with a message expected end sub error....Please help me

2. I would be greatly thankful for your help if you could explain me this code....

Below is what i understood ... Please correct me if i am wrong

Dim ws As Worksheet

You told excel to understand as worksheet whenever you write ws

Dim c As Range

You told excel to understand as c as Range whenever you write c (but what is the range??)


Please if you can explain me it would be really great help for me

Thankyou friend for your support

 

[Chihiro]

1. My bad. "End Sub" wasn't copied. Just stick that at the end (original post edited as well).

2. Let me update code with explanation.

 

[Chihiro]

Here you go.

Option Explicit
Private Sub Worksheet_Activate()
Dim ws As Worksheet
Dim c As Range
Dim lRow As Long
'Check for last row with data in "Master" Sheet
lRow = Cells(Rows.Count, 1).End(xlUp).Row

'If last row with data is greater than 3 clear all cell contents from A4 to C(last Row)
If lRow > 3 Then
    Range("A4:C" & lRow).ClearContents
End If

For Each ws In Sheets(Array("SD", "PG", "MIN"))
    With ws.Cells
'Use Range.Find method to find Column Header "ID"
'c is range but in this case, it's the cell where "ID" is found
        Set c = .Find("ID", After:=Cells(1), LookIn:=xlValues, Lookat:=xlWhole, _
            SearchOrder:=xlByColumns, MatchCase:=True)
'If "ID" is found (if c is not empty)
        If Not c Is Nothing Then
'Get last Row with data for Column (for c)
            lRow = ws.Cells(Rows.Count, c.Column).End(xlUp).Row
'copy range starting at 1 row below c, same column as c to last row and column 2 to right of c
            ws.Range(ws.Cells(c.Row + 1, c.Column), ws.Cells(lRow, c.Column + 2)).Copy _
            Sheets("Master").Range("A65536").End(xlUp)(2)
        End If
    End With
Next ws
End Sub

 

[chssundeep]

Dear Chihiro,

Thank you very much for your time for explaining me in detail....

Sorry but I am at ABC level in Vb script ....

So one more request...Please update the code as per attached new sheet...

Once again I wholeheartedly thank you for your effort....

 

[Chihiro]

Couple of questions.

1. Do you want to append new data in Master or should Master be cleared and new data copied.
2. There are more columns than 3 that's being copied to Master. Should those be cleared from Master or kept when data is copied for 3 columns.

 

[chssundeep]

In PG SD and MIN sheets the data gets added regularly.... So whenever the data gets added to that respective sheet.... The same has to update in the Masters..

All the data in PG,SD and MIN should be there as it is....

 

[Chihiro]

Ah, then the code will change quite a bit. I'll be busy for next couple of hours at work. Will update once I get home tonight.

 

[Chihiro]

See attached.

I decided to keep same structure as original code as I don't know your workbook structure (formulas etc). Only difference in the code being added lines for non-contiguous column (and 1 less column for the initial columns).

If range becomes large and/or there are multiple calculations in other columns, code may take a while as it clears entire contents for columns D, E & J on the Master sheet before grabbing 3 columns from other sheets (entire columns and not just added info).

Let me know if that's the case and I'll make additional changes.

 

[chssundeep]

Thank you very much

 

[chssundeep]

Hi Chihiro,

Sorry for troubling you again.........

The data in the columns are not being updated in the below heads

Total S.No Work1 Work2 Work3 Work4 Group Delivery 3



and Can you please explain this part of code....

Set c = .Find("ID", After:=Cells(1), LookIn:=xlValues, Lookat:=xlWhole, _
SearchOrder:=xlByColumns, MatchCase:=True)

For the above code... Will this search first ID and next one by one???

If Not c Is Nothing Then
lRow = ws.Cells(Rows.Count, c.Column).End(xlUp).Row
ws.Range(ws.Cells(c.Row + 1, c.Column), ws.Cells(lRow, c.Column + 1)).Copy _
Sheets("Master").Range("D65536").End(xlUp)(2)


ws.Range(ws.Cells(c.Row + 1, c.Column + 11), ws.Cells(lRow, c.Column + 11)).Copy _
Sheets("Master").Range("J65536").End(xlUp)(2)


Please explain the above code

 

[Chihiro]

Ah, since you had no data in those areas. I assumed it was handled some other way.

Set c = .Find("ID", After:=Cells(1), LookIn:=xlValues, Lookat:=xlWhole, _
SearchOrder:=xlByColumns, MatchCase:=True)

1. It looks for "ID" as literal string looking from column to column starting at cell A1 and records first cell where exact match is found (i.e. ID column header). In updated code, it's been changed to "Total" column header.

2. Next part of the code uses recorded "c" as reference point.

If Not c Is Nothing Then

Using if statement to only proceed if exact match is found (double negative).

lRow = ws.Cells(Rows.Count, c.Column).End(xlUp).Row

Using c.Column look for the last row with data in it.

ws.Range(ws.Cells(c.Row + 1, c.Column), ws.Cells(lRow, c.Column + 1)).Copy _
Sheets("Master").Range("D65536").End(xlUp)(2)

This part also changed in new code. But originally... it defined range to copy as.
Starting at Cell 1 row below "c" and same column as "c" going to last row with data and one column to right of "c".

Second part sets copy destination to "Master" sheet and finds first row in column D with no data and pastes info. Same thing is done for different range as well.

See attached for updated code with dummy data for other columns.

 

[chssundeep]

Thanks a TON my dear friend

 

[chssundeep]

Hi Chihiro,

Sorry for disturbing you again........

Again Im facing an Compile error 91......when clicked on debug its landing me to Debug.Print c.Address

So attaching the actual format...Please update the code for this


Really I wholeheartedly Thank you for the Help..... It would have been very difficult for me without your solution

 

[NARAYANK991]

Hi ,

That is because there is no data to be found.

See the attached file ; I have used an IF statement to not print the address if c is nothing.

Narayan

 

[chssundeep]

Dear Narayan,

Thanks for the reply.......
You have rightly identified the problem .....I updated the data and checked it it working fine....

I tried the solution provided by you.........the header in Master sheet is also being deleted and no data is getting update......

Could you kindly check it once please.......