Data Consolidation with VBA

[RCPT]

Hello,
I'm not sure how to consolidate several columns of different sheets into one table in a single sheet.
Not even sure if the code I'm writing makes sense!

I want the consolidated data sheet to aggregate several columns from different working sheets. I am trying to do it with VBA because the rows in each sheet have different information tiers.

I want to copy column "E" from sheet3 to sheet consolidate data only when the value in column "C" is "GA", and I want the data copied to the sheet sequentially not with gaps.

VBA_test.xlsm

Can you help?

Thank you,

Rute

[georgiboy]

I may have misunderstood but looking at your code were you trying to do the below:

Sub DataConsolidation()    
    Dim wsc1 As Worksheet 'worksheet1 copy
    Dim wsc2 As Worksheet 'worksheet2 copy
    Dim wsc3 As Worksheet 'worksheet3 copy
    Dim wsd As Worksheet 'worksheet destination
    Dim lrow1 As Long 'last row of worksheet1 copy
    Dim lrow2 As Long 'last row of worksheet2 copy
    Dim crow As Long 'copy row
    Dim drow As Long 'destination row
    Dim trow As Long 'tmp row
    
    Set wsc1 = Sheets("Sheet1")
    Set wsc2 = Sheets("Sheet2")
    Set wsc3 = Sheets("Sheet3")
    Set wsd = Sheets("Consolidated data")
    
    crow = 2: drow = 3
    lrow2 = wsc2.Columns(1).Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    lrow3 = wsc3.Columns(2).Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    
    With wsc2
        For crow = 2 To lrow2 'starts at 2 because of the header row
            wsd.Cells(drow, 2).Value = .Cells(crow, 1).Value
            wsd.Cells(drow, 5).Value = .Cells(crow, 7).Value
            drow = drow + 1
        Next crow
    End With
    
    drow = 3
    trow = 3
    
    With wsc3
        For crow = 2 To lrow3 'starts at 2 because of the header row
            If Sheets("Sheet3").Cells(crow, 3).Value = "GA" Then
                wsd.Cells(trow, 4).Value = wsc3.Cells(trow, 5).Value
                trow = trow + 1
            End If
            wsd.Cells(drow, 3).Value = .Cells(crow, 4).Value
            drow = drow + 1
       Next crow
    End With
End Sub

[snb]

Use autofilter.
Avoid empty rows/columns: e.g. column A in Sheet 3

[RCPT]

I tried your code but it doesn't overcome my difficulty which is to copy only columns "D" and "E" (sheet 3 in yellow fill) if the value in column "C" is "GA" (red font) and have these values be copied without row gaps in sheet "Consolidated Data".



VBA_test.2.xlsm

Thank you for your help,

Rute

[RCPT]

Use autofilter.
Avoid empty rows/columns: e.g. column A in Sheet 3

Not sure if I understood How the autofilter will solve my need...could you elaborate?

For most sheets I can't avoid neither empty rows or columns, because this is a tool that will be filled in by different people according to their own process needs. And the columns are arranged to follow a specific standardized format. How can empty rows and columns interfere with the code?

Thank you,

Rute

[RCPT]

VBA_test.3.xlsm

Hello,
I have created a new column in Sheet3 that I think simplifies the code needed. Now I need to copy cells in the new column that are not blank, in a sequential way, meaning without the gaps in the sheet3 to sheet: consolidated data.
Help, anyone?

Sub DataConsolidation()
    Dim wsc1 As Worksheet 'worksheet1 copy
    Dim wsc2 As Worksheet 'worksheet2 copy
    Dim wsc3 As Worksheet 'worksheet3 copy
    Dim wsd As Worksheet 'worksheet destination
    Dim lrow2 As Long 'last row of worksheet1 copy
    Dim lrow3 As Long 'last row of worksheet2 copy
    Dim crow As Long 'copy row
    Dim drow As Long 'destination row
    Dim trow As Long 'tmp row
    
    Set wsc1 = Sheets("Sheet1")
    Set wsc2 = Sheets("Sheet2")
    Set wsc3 = Sheets("Sheet3")
    Set wsd = Sheets("Consolidated data")
    
    crow = 2: drow = 3
    lrow2 = wsc2.Columns(1).Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    lrow3 = wsc3.Columns(2).Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    
    With wsc2
        For crow = 2 To lrow2 'starts at 2 because of the header row
            wsd.Cells(drow, 2).Value = .Cells(crow, 1).Value
            wsd.Cells(drow, 5).Value = .Cells(crow, 7).Value
            drow = drow + 1
        Next crow
    End With
    
    drow = 3
    trow = 3
    
    With wsc3
        For trow = 2 To lrow3 'starts at 2 because of the header row
            
            If Len(Trim(wsc4.Cells(crow, 7).Text)) > 0 Then
            wsd.Cells(drow, 4).End(xlUp).Value = .Cells(trow, 7).Text
         
            trow = trow + 1
            End If
            
            wsd.Cells(drow, 3).Value = .Cells(crow, 4).Value
            drow = drow + 1
       Next crow
    End With
End Sub

[RCPT]

Hello,
I am researching this challenge further...and tried to paste special while skip blanks, but it's not working either. Still stuck on the same problem.
Help is deeply appreciated.


My code as follows:

Sub DataConsolidation()
Dim wsc1 As Worksheet 'worksheet copy 1
Dim wsc2 As Worksheet 'worksheet copy 2
Dim wsc3 As Worksheet 'worksheet copy 3
Dim wsc4 As Worksheet 'worksheet copy 4
Dim wsc5 As Worksheet 'worksheet copy 5
Dim wsc6 As Worksheet 'worksheet copy 6
Dim wsc7 As Worksheet 'worksheet copy 7
Dim wsd As Worksheet 'worksheet destination
Dim lrow2 As Long 'last row of worksheet copy
Dim lrow4 As Long 'last row of worksheet copy
Dim crow As Long 'copy row
Dim drow As Long 'destination row
Set wsc1 = Sheets("1.1 Cultivation Plan")
Set wsc2 = Sheets("1.2 Post Harvest Plan")
Set wsc3 = Sheets("1.3 Quality Plan")
Set wsc4 = Sheets("1.4 Inventory")
Set wsc5 = Sheets("1.5 Commercial")
Set wsc6 = Sheets("1.6 Deleted & Other Shipment")
Set wsc7 = Sheets("1.7 Demand")
Set wsd = Sheets("Consolidated Data")
crow = 4
drow = 4
lrow2 = wsc2.ListObjects("1.2 Post Harvest Plan").Range.Columns(11).Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
lrow4 = wsc4.ListObjects("1.4 Inventory").Range.Columns(5).Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
With wsc2
For crow = 4 To lrow2 'starts at 4 because of the header row
wsd.Cells(drow, 4).Copy
        wsc4.Cells(crow, 7).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=True
drow = drow + 1
Next crow
End With
End Sub

[snb]

Not ignoring sound advice is highly appreciated.

[RCPT]

Not ignoring sound advice is highly appreciated.

Hello,

I'm not sure if I understood your comment.
I am not ignoring any advice. As I have explained I don't know how to code the autofilter (I am just learning how to code VBA alone) and hence asked for help. Regarding the empty columns, it does not depend on me, this is how the company has built the tool.

But thank you anyway for your time.

Best regards,

Rute Teixeira

[georgiboy]

Working from your Test3 spreadsheet the below would be an example of using the filter you already have on to copy the data where product is "GA" and move it over to the Consolidated data tab. I am not quite sure what values you want in there with them but thought this would help as a start.
Might be worth providing a worksheet with the full expected result so we have something to aim at.

Sub DataConsolidation()    
    Dim rng As Range

    Set rng = Sheet3.Range("B2:E" & Sheet3.Range("B" & Rows.Count).End(xlUp).Row)
    
    With rng
        .AutoFilter 2, "GA"
        .Offset(, 2).Resize(, 2).SpecialCells(xlCellTypeVisible).Copy
    End With
    Sheet4.Range("C3").PasteSpecial xlPasteValues
End Sub

[RCPT]

Hi,

That does what I need! Thank you so much.
Best,

Rute Teixeira

[snb]

How unexpected to find 'autofilter' in the code.

[Aussiebear]

How unexpected to find 'autofilter' in the code.

Come on snb..... Georgiboy may well be the lord High Chancellor of Kent, but even I had a belief that he would slip a little "auto filter" in the code.

[georgiboy]

Use autofilter.
Avoid empty rows/columns: e.g. column A in Sheet 3

Was the suggestion.

Not sure if I understood How the autofilter will solve my need...could you elaborate?

Was the return question.

Not ignoring sound advice is highly appreciated.

Was the answer.

I was merely filling in some gaps and being a good little helper

lord High Chancellor of Kent

lol I may have to adopt this title - I like the sound of it...

[Aussiebear]

Absolute power corrupts even the best of people sire

[RCPT]

Thank you for the sarcasm snb and for the candid help georgiboy.

It was the first time I joined a forum and asked for help. I was so impressed by the response that I was not expecting what happened in this thread.
I was not aware that people starting to learn to code VBA were not welcome or would be humiliated.

I'm a Marine Biologist, Management Consultant and Children Life Coach. Been working since my 20's, volunteer with children and animals since my teens, support my community, work hard to provide for my family and to make the world a better place; so I apologize for not knowing how to write VBA code (or any code for that matter) and still be willing to try.

You know, people are not measured by what they know but by who they are and make an effort to be. I can only feel sorry for you snb, for you lack of humbleness and ill disposition. I can recommend you a good life coach if you'd like.

And do not fret I will find another more welcoming forum to ask for help.
All the best,

Rute

[snb]

Let's talk about 'willingness to help' after you finished this: https://www.snb-vba.eu/index_en.html

[georgiboy]

And do not fret I will find another more welcoming forum to ask for help.

As is the case for quite a few that come here, I like this forum but it does contain a few people that routinely get out of the wrong side of bed. The kind of people that will harass a learner driver on the road or be angry with a colleague on their first day.

I come here to see people learn and flourish as I did from this forum - some come here to be right and exercise one-upmanship.

Not to subtract from some of the true experts here as the knowledge on this forum is probably greater than other forums IMO.

[Aussiebear]

Well said Georgiboy. RCPT has tried to put forward a genuine post and yes he admits to not knowing the correct coding. He's a learner as we all are. RCPT , you are more than welcome to contribute to this forum in what ever means you think necessary.

[RCPT]

Let's talk about 'willingness to help' after you finished this: https://www.snb-vba.eu/index_en.html

I appreciate the learning tip. It looks well structured and hands on.

best,

Rute