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.

29668

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".



29673

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]

29675

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 :thumb


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

[Aussiebear]

Hold the stagecoach... I've moved my rook 2 forward and one to the left and you say its solved...? Georgiboy was moving solidly across my chessboard ( laying waste to all and sundry), without fear or favour and bingo its solved???? Are you certain its solved Rute?

[Bob Phillips]

Georgiboy may well be the lord High Chancellor of Kent.

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

Come on, the Chancellor is chancellor of the realm, never in your wildest dreams can you claim Kent is a realm, never mind the realm (and I know, I spent a few days in Rochester a couple of weeks ago :()

[georgiboy]

How the world is small' I live in Rochester, it's not as pretty as the postcard.

[Paul_Hossler]

Hold the stagecoach... I've moved my rook 2 forward and one to the left and you say its solved...?

If you moved your rook like that, someone is not paying attention

https://www.wholesalechess.com/pages/chess-101-chess-basics/chess-pieces-and-how-they-move.html

[Aussiebear]

If you moved your rook like that, someone is not paying attention

Paul we are convicts living in the bush..... any rules will do.