PDA

View Full Version : Transfering data from one main sheet to multiple worksheets based on multiple conditi



joky
07-17-2017, 05:40 AM
Hello everyone
I have attached the following example To make the idea more clearly
It is excellent But when you execute the code, the data transfer process starts from the second row and very slow in dealing With tons of data so I need a faster solution using arrays
For example I have data starting at row 8
In Main sheet the column No. 31 the word "Yes" I want to copy columns from 1 : 5 with columns from 33 : 36
depending on the 31 column and transferred them to the " yes" sheet
and In Main sheet the column No. 32 the word "no" I want to copy columns from 1 : 5 with columns from 37 : 40
depending on the 32 column and transferred them to the " no" sheet
I need to insert six rows after each 30 names in two sheets (yes & no)
These rows will serve as totals and footer.
I have highlighted the points where I would like to insert the rows
if the remain items is less than 30 then to insert rows directly after them
During that process I would like to add some strings in these inserted lines
in the first inserted row To create the totals formulas and the formatting
in the second inserted row type : "Signature" in column B and in column D: "Signature" and in column H: "Signature"
in the third inserted row type : "Auditor" in column B and in column D: "Head of Accounts" and in column H: "General Manager"
in the sixth inserted row To create the previous totals and the formatting
With adjust the vertical and horizontal page breaks automatically
Note For the four footer rows that Between the tables, I need to insert rows without borders
I hope the idea is clear and I hope a solution using arrays
Please have a look at the example
Your help is greatly appreciated
Thanks in advance

joky
07-17-2017, 12:09 PM
Your help is greatly appreciated

p45cal
07-17-2017, 03:27 PM
Attached has button in Source data sheet. All code in Module1.

mdmackillop
07-17-2017, 03:43 PM
Another one to try; maybe a little finishing needed.

joky
07-17-2017, 06:29 PM
Thank you very much for your help me
it seems for me that it will be difficult to deal with such cases
i tried something similar earlier but it took lot of time ..
To be honest I do not deal with small amounts of data but using arrays in VBA makes life easier this is my point of view
Are there ways faster than that ... I think so
Your help is greatly appreciated
Best Regards

p45cal
07-18-2017, 03:06 AM
To be honest I do not deal with small amounts of data but using arrays in VBA makes life easier this is my point of view
Are there ways faster than that ... I think so
So how much data ARE we talking about?
Faster? Well, with your data on my old machine it took 2.2 seconds. I spent an hour or so writing the code. I'm not going to spend another hour to save you 2.2 seconds - especially if you only do this once a month.
So again, just how much data are we talking about?

joky
07-18-2017, 03:13 PM
Thanks a lot for reply
Thanks for your great support .... I appreciate your time well
As for the amount of data in the main sheet, it sometimes reaches 50,000 rows = 2,500 pages
so you find most of my issues are about arrays and dealing with arrays
This is my attempt by using arrays,Where the data was transferred according to the two conditions
But I could not reach towards the ultimate aim ..... Please have a look at the example
Your help and your time is greatly appreciated
Best regards for all of you


Option Explicit
Sub TransferByTwoConditions()
Dim lr As Long, x As Long, i As Long, j As Long
Application.ScreenUpdating = 0
With Sheets("Main sheet")
lr = .Range("A" & Rows.Count).End(xlUp).Row
ReDim arr(1 To lr, 1 To 40)
ReDim sn(1 To lr, 1 To 9)
ReDim sn2(1 To lr, 1 To 9)
arr = .Range("A8", "AN" & lr).Value
i = 1: j = 1
For x = 1 To UBound(arr)
If arr(x, 31) = "YES" Then
sn(i, 1) = arr(x, 1): sn(i, 2) = "'" & arr(x, 2): sn(i, 3) = arr(x, 3): sn(i, 4) = arr(x, 4): sn(i, 5) = arr(x, 5)
sn(i, 6) = arr(x, 33): sn(i, 7) = arr(x, 34): sn(i, 8) = arr(x, 35): sn(i, 9) = arr(x, 36)
i = i + 1
End If
If arr(x, 32) = "NO" Then
sn2(j, 1) = arr(x, 1): sn2(j, 2) = "'" & arr(x, 2): sn2(j, 3) = arr(x, 3): sn2(j, 4) = arr(x, 4): sn2(j, 5) = arr(x, 5)
sn2(j, 6) = arr(x, 37): sn2(j, 7) = arr(x, 38): sn2(j, 8) = arr(x, 39): sn2(j, 9) = arr(x, 40)
j = j + 1
End If
Next
If i > 1 Then Sheets("YES").Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(i - 1, 9) = sn
If j > 1 Then Sheets("NO").Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(j - 1, 9) = sn2
With Sheets("YES")
lr = .Range("A" & Rows.Count).End(xlUp).Row
If lr > 6 Then .Range("A8", "I" & lr).ClearContents
.Range("A8").Resize(UBound(arr), 9) = sn
End With
With Sheets("NO")
lr = .Range("A" & Rows.Count).End(xlUp).Row
If lr > 6 Then .Range("A8", "I" & lr).ClearContents
.Range("A8").Resize(UBound(arr), 9) = sn2
End With
End With
End Sub




If possible to deal with the attachment to achieve the points referred to

joky
07-18-2017, 11:54 PM
Hope to find solution

snb
07-19-2017, 02:56 AM
1. Never, I repeat never, use 'merged cells'
2. Never use columnheads that do not exist in the origial data: e.g. 'hgvvvv'


Sub M_snb()
Sheets("Yes").Cells.UnMerge
Sheets("Yes").Cells.Clear

Sheets("No").Cells.UnMerge
Sheets("No").Cells.Clear

with Sheets("main sheet")
.Cells.UnMerge

.Columns(1).SpecialCells(4).EntireRow.Delete
.Columns(6).Delete
.Range("AZ1:AZ2") = Application.Transpose(Array("31", "Yes"))

.Cells(1).CurrentRegion.AdvancedFilter 2, .Range("AZ1:AZ2"), Sheets("yes").Cells(1)
end with
End Sub

joky
07-19-2017, 04:04 AM
Thanks a lot Mr. snb
I was lucky to find that great forum
Thank you very much for your great support in this issue
I tried to complete my idea but could not do it
- for the first five rows, it is for the company name, address, etc.
- There should be a headers for columns in rows No. 6 & 7 to specify their titles
- As for the merged cells are important for me and The code works well without a problem in my first attempt
Do you Can any changes made to the file to do the purpose of it
Best regards for all of you

snb
07-19-2017, 04:55 AM
Please analyse the code so you will be able to adapt it.
We're not here to provide turnkey solutions (that would be assignments to be paid for).
There's no reason to use merged cells ever.
As you may have noticed: my code is very fast.

joky
07-19-2017, 07:31 AM
Thanks a lot Mr. snb
It's a great pleasure to know someone like you
I did not ask to create a solution from scratch ... Just ask for help in specific points if possible
anyway thank you so much for your help
Regards

p45cal
07-19-2017, 04:20 PM
snb, do I detect a flavour of your style in the code in msg#7 above - has it been adapted from something you did?

joky, re:
it sometimes reaches 50,000 rows = 2,500 pages
In the linked-to file below (it was too large to attach), there are about 67,000 rows with data among some 88,000 rows on the data source sheet. At 30 data rows per page that comes to 1136 pages for the No camp and 892 for the Yes camp.
Both the 1136 and your 2500 pages exceed the number of manual page breaks allowed (1024) on a single sheet in Excel 2010 (later versions may have increased this limit). So I had to resort to changing the bottom margin in Page setup until Excel's automatic page breaks fell in the right place. That and formatting the sheet with borders and bold in the right places takes about half the time of the macro execution time. On my (old) machine it takes some 15 seconds to produce both sheets. I adapted the code in msg#7; this means that the execution time does not go up exponentially with the row count on the data source sheet as it does with Advanced Filter which is what I tried earlier.
Your merged cells don't seem to matter in this case, but snb is very right; vba and merged cells will bite you on the bum at some point!

Now, is this 2,500 pages just hype and this is all an academic exercise?!
Wanting to save a few seconds to produce 2.5k pages (which is 5 reams of A4!) - I can just imagine the glee with which the Auditor, General Manager and Head of Accounts will greet those 5 reams on landing on their desks; they'll look forward to checking and signing each page! If they were super fast and it took only 5 seconds to check and sign each page, it would take each of them 3.5 hours to do it. At their rate of pay, the few seconds or minutes you save pales into insignificance…

The file:
https://app.box.com/s/sz4ni8w1567877mdw0y3tyi78szv2j67

joky
07-19-2017, 06:50 PM
Thanks a lot Mr. p45cal You are awesome and brilliant
I feel I am idiot .. You are right ,It seems I didn't clarify well. My apologies to you

However, the work tasks divided into eight users, so the talk is logical
Best regards for all of you

snb
07-20-2017, 12:37 AM
@p45cal

Yes I noticed it too.
I can't remember having had something to do with it before.
The declarations and use of : are definitely not in accordance with my 'style'. ;)