VBA copy numerous cells to new sheet based on criteria

[Akashwani]

Good day MrExcelers!

I have been given a Workbook to "tidy up", it's been a long time and I'm seriously struggling, so here I am!

I have a Worksheet that I CANNOT alter the layout of and that is making it difficult to find a suitable VBA code to copy the key data from the Active sheet to a "DataHistory" sheet.

The criteria will be in Column AE (Rows 3-31) in the form of a number.

The Cells I want to copy will be in these Columns and in the following order...
AE, A, F, H, J, K, L, M, O, Q, S, U, W, Y, Z, AA, AC, AD

The Cells that meet the required Criteria need to be copied to the next empty row on Sheet "DataHistory"

Example...
If AE3, AE6, AE20, AE31 have a number in, then the relevant cells on those rows need to be copied to the next empty Row on Sheet "DataHistory". So, the Data from Row3 would be copied to the next empty Row, from Row6 to the next empty Row and so on.

I hope that is clear, but I have some doubts!

Thank you for looking at this and I await some positive replies.

Ak

 

[DocAElstein]

Hi,
. I have just finished a working code for you. I will Tidy it up a bit and post it early Tomorrow
Alan
Bavaria

 

[DocAElstein]

Hi <o></o>
….. Here is mysolution to your Problem. It is a somewhat simple “Beginners” type Solution. Itis based on how I am currently solving the Problem which is my main reason forgetting involved with Excel VBA. This problem is the Sorting and Reorganizing ofa very large data File and bringing new data into it. The new data can be invarious forms, that is to say in incontinently column order. So something similarI guess to what you are doing.<o></o>
. One ofmy first Threads was asking for improvements to this method (http://www.mrexcel.com/forum/excel-questions/792647-simple-data-sort-merge-code.html ). It got no replies so I have been learning, amongst other things from participating in this forum, and I particularlylearn lots when a Profi comes in later to a thread like yours that I answer and later and gives a better solution. So Let’sboth keep our fingers crossed for that!!.....<o></o>
<o> </o>
<o> </o>
….Anyways thesolution I have for you:- <o></o>
<o> </o>
. You will see that I have slightly reorganizedyour DataHistory Sheet, that is to say you have an extra heading Row with Addressesin it. <o></o>
<o> </o>
<o> </o>
<o>

Book1
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S
1	$AE$1	$A$1	$F$1	$H$1	$J$1	$K$1	$L$1	$M$1	$O$1	$Q$1	$S$1	$U$1	$W$1	$Y$1	$Z$1	$AA$1	$AC$1	$AD$1
2	Header1	Header2	Header3	Header4	Header5	Header6	Header7	Header8	Header9	Header10	Header11	Header12	Header13	Header14	Header15	Header16	Header17	Header18
3
DataHistory

</o>
<o> </o>
<o> </o>
<o> </o>
..Yes, you mayhave you guessed it - the Addresses in this new heading row are those for the relevantmatching first Row Columns in the newData which you wish to include in Data History Sheet. <o></o>
<o> </o>
. So the programbasically checks For a match in the address, and then copies in the relevantColumn<o></o>
<o> </o>
. You can changethe order or add or delete column Addresses in the extra heading row. Theprogram will take care of that and put all Data in the new corresponding order(If you see what I mean?)<o></o>
<o> </o>
. Here is a partof the DataHistory Sheet before running the Macro<o></o>
<o> </o>
<o>

Book1
	A	B	C	D	E
1	$AE$1	$A$1	$F$1	$H$1	$J$1
2	Header1	Header2	Header3	Header4	Header5
3
4
5
6
7
8
9
DataHistory

</o>
<o> </o>
<o> </o>
. Here is thesame again after running the program twice<o></o>
<o> </o>
<o>

Book1
	A	B	C	D	E
1	$AE$1	$A$1	$F$1	$H$1	$J$1
2	Header1	Header2	Header3	Header4	Header5
3	19.08.2014	U09575	860	126.42	140
4	19.08.2014	U09576	2561	326.53	280
5	19.08.2014	U09659	3403	666.99	640
6	19.08.2014	U09875	2496	449.28	490
7	19.08.2014	U09918	7302	1314.4	1370
8	19.08.2014	91204	934	44.83	46
9	19.08.2014	42393	2221	124.38	128
10	19.08.2014	42513	560	57.12	58
11	19.08.2014	42510	2834	201.21	205
12	19.08.2014	42392	1197	67.03	68
13	19.08.2014	U09575	860	126.42	140
14	19.08.2014	U09576	2561	326.53	280
15	19.08.2014	U09659	3403	666.99	640
16	19.08.2014	U09875	2496	449.28	490
17	19.08.2014	U09918	7302	1314.4	1370
18	19.08.2014	91204	934	44.83	46
19	19.08.2014	42393	2221	124.38	128
20	19.08.2014	42513	560	57.12	58
21	19.08.2014	42510	2834	201.21	205
22	19.08.2014	42392	1197	67.03	68
23
24
DataHistory

</o>
<o> </o>
. So you seethat new data is added after any existing data<o></o>
<o> </o>
<o> </o>
. Here is a fullCode:<o></o>
<o> </o>
<o> </o>
<o> <font face=Calibri><SPAN style="color:#00007F">Option</SPAN> <SPAN style="color:#00007F">Explicit</SPAN> <SPAN style="color:#007F00">'Not necerssary to do this but helps limit Computer Memory usage and helps show up typing errors when writing code</SPAN><br><SPAN style="color:#00007F">Sub</SPAN> SimpleSortOfASort()<br><SPAN style="color:#00007F">On</SPAN> Err <SPAN style="color:#00007F">GoTo</SPAN> TheEnd <SPAN style="color:#007F00">'  Go to the End rather than crashing if an error occurs</SPAN><br>Application.ScreenUpdating = <SPAN style="color:#00007F">False</SPAN> <SPAN style="color:#007F00">'Not necerssaryy but speeds things up a bit by not continually updating the screen</SPAN><br>  <SPAN style="color:#00007F">Dim</SPAN> NewDataMaxRow <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Byte</SPAN>, DataHistoryLastRow <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Byte</SPAN> <SPAN style="color:#007F00">'Byte limits the Row size to 255</SPAN><br>  <SPAN style="color:#00007F">Let</SPAN> NewDataMaxRow = Worksheets("TypicalData").Cells(Rows.Count, 1).End(xlUp).Row <SPAN style="color:#007F00">'Get maximum Row For new data</SPAN><br>  <SPAN style="color:#00007F">Let</SPAN> DataHistoryLastRow = Worksheets("DataHistory").Cells(Rows.Count, 1).End(xlUp).Row <SPAN style="color:#007F00">'Get last Row where  data was inputed in Data History Sheet</SPAN><br>  <SPAN style="color:#00007F">Dim</SPAN> NewDataColumnMax <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Byte</SPAN>, DataHistoryColumnMax <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Byte</SPAN> <SPAN style="color:#007F00">'Limit Columns to 255</SPAN><br>  <SPAN style="color:#00007F">Let</SPAN> NewDataColumnMax = Worksheets("TypicalData").Cells(1, Columns.Count).End(xlToLeft).Column <SPAN style="color:#007F00">'Get Maximum Column in new Data</SPAN><br>  <SPAN style="color:#00007F">Let</SPAN> DataHistoryColumnMax = Worksheets("DataHistory").Cells(1, Columns.Count).End(xlToLeft).Column <SPAN style="color:#007F00">''Get Maximum Column in Data History Sheet</SPAN><br>  <SPAN style="color:#00007F">Dim</SPAN> NewDataRow <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Byte</SPAN>, DataHistoryRow <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Byte</SPAN>, NewDataColumn <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Byte</SPAN>, DataHistoryColumn <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Byte</SPAN><br>    <SPAN style="color:#00007F">For</SPAN> NewDataColumn = 1 <SPAN style="color:#00007F">To</SPAN> NewDataColumnMax <SPAN style="color:#00007F">Step</SPAN> 1 <SPAN style="color:#007F00">' go through each column of new data</SPAN><br>      <SPAN style="color:#00007F">For</SPAN> DataHistoryColumn = 1 <SPAN style="color:#00007F">To</SPAN> DataHistoryColumnMax <SPAN style="color:#00007F">Step</SPAN> 1 <SPAN style="color:#007F00">'Go througth every Data History column</SPAN><br>      <SPAN style="color:#00007F">If</SPAN> Worksheets("TypicalData").Cells(1, NewDataColumn).Address = Worksheets("DataHistory").Cells(1, DataHistoryColumn).Value <SPAN style="color:#00007F">Then</SPAN> <SPAN style="color:#007F00">'look for match in address</SPAN><br>        <SPAN style="color:#00007F">Let</SPAN> DataHistoryRow = DataHistoryLastRow <SPAN style="color:#007F00">'Before Putting the next column in, Reset the data history Row.</SPAN><br>        <SPAN style="color:#00007F">For</SPAN> NewDataRow = 1 <SPAN style="color:#00007F">To</SPAN> NewDataMaxRow <SPAN style="color:#00007F">Step</SPAN> 1 <SPAN style="color:#007F00">'Go through each new data value in the column...</SPAN><br>        <SPAN style="color:#00007F">Let</SPAN> DataHistoryRow = DataHistoryRow + 1 <SPAN style="color:#007F00">'New row for DataHistory'...go to a new row in Data History....</SPAN><br>        Worksheets("TypicalData").Cells(NewDataRow, NewDataColumn).Copy Destination:=Worksheets("DataHistory").Cells(DataHistoryRow, DataHistoryColumn) <SPAN style="color:#007F00">'...And Copy the appropriate vale. Note we choose to use Copy Destination:= method as then your original formatting is preserverd</SPAN><br>        <SPAN style="color:#00007F">Next</SPAN> NewDataRow <SPAN style="color:#007F00">'Go to next new data value in column..</SPAN><br>      <SPAN style="color:#00007F">Else</SPAN> <SPAN style="color:#007F00">' If no match.....</SPAN><br>      <SPAN style="color:#007F00">'....Do nothing!</SPAN><br>      <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>      <SPAN style="color:#00007F">Next</SPAN> DataHistoryColumn <SPAN style="color:#007F00">'Once all rows are copied go back and look again for a matching column address</SPAN><br>    <SPAN style="color:#00007F">Next</SPAN> NewDataColumn <SPAN style="color:#007F00">'Start ther whole thing again for the next column in in the New Data</SPAN><br>TheEnd:<br>Application.ScreenUpdating = <SPAN style="color:#00007F">True</SPAN> <SPAN style="color:#007F00">'Turn Screen updating back on. Important to put this here, otherwise in the event of an error, your screen stays "Dead"!</SPAN><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN> <SPAN style="color:#007F00">'SimpleSortOfASort()</SPAN></FONT></o>
<o> </o>
<o> </o>
. And here asimplified one without ‘Green comments graffiti etc.<o></o>
<o> </o>
<o>

Sub SimplifiedSimpleSortOfASort()
DataHistoryLastRow = Worksheets("DataHistory").Cells(Rows.Count, 1).End(xlUp).Row
    For NewDataColumn = 1 To Worksheets("TypicalData").Cells(1, Columns.Count).End(xlToLeft).Column
      For DataHistoryColumn = 1 To Worksheets("DataHistory").Cells(1, Columns.Count).End(xlToLeft).Column
      If Worksheets("TypicalData").Cells(1, NewDataColumn).Address = Worksheets("DataHistory").Cells(1, DataHistoryColumn).Value Then
        DataHistoryRow = DataHistoryLastRow
        For NewDataRow = 1 To Worksheets("TypicalData").Cells(Rows.Count, 1).End(xlUp).Row
        DataHistoryRow = DataHistoryRow + 1
        Worksheets("TypicalData").Cells(NewDataRow, NewDataColumn).Copy Destination:=Worksheets("DataHistory").Cells(DataHistoryRow, DataHistoryColumn)
        Next NewDataRow
      End If
      Next DataHistoryColumn
    Next NewDataColumn
End Sub

</o>
<o> </o>
<o> </o>
. Also here is a file with all macros in them(In module “Get Sort Id”)<o></o>
<o> </o>
<o> </o>
<o> </o>
http://snk.to/f-ctmyuy0i<o></o>
<o> </o>
<o> </o>
. As I mentioned there are definitely lots ofimprovements that can be done. As I am practicing with this sort of thing Icould have another go sometime if no Profi comes in with something better inthe meantime. <o></o>
.. And get back to me with any questions /comments, for example if you need help to (remember?) the basic way to get thecodes running etc.<o></o>
<o> </o>
Alan.<o></o>
<o> </o>
P.s. A few points to bear in mind<o></o>
.1 I have limited various Columns and rows fornow to 255. But (depending on which version of Excel you have) this can easily bechanged.<o></o>
.2 That extra heading row does not need to beexactly there in Data History. It could be in a spare Sheet or somehow storedin a Matrix / Array type of thing. The Program can easily be modified to dothat. But I thought for demonstration purposes it was good to have it there soyou can see exactly from which columns your data is coming from.<o></o>
.3 As it stands your new data must be in the TypicalData sheet. But it is easy to modify the program to bring data from an active sheet. So then you could bring data in from different files. (But againyou must check the order of your columns. Then if there are variations thenchange that extra Heading Row appropriately)<o></o>
.4 Sheet MiscMacros in the file I send you, youcan trash – in that the sheet and that sheet module I was experimenting. But Ileave it in in case anything there is useful to you<o></o>
.5 Thesimplified macro will not work unless you comment out (Or delete) The firstline in the Get Sort Id module, Option Explicit<o></o>

 

[Akashwani]

Hi Alan, WOW.
Thank you so very much for all the hard work and time you have put into trying to resolve this for me, it is greatly appreciated.

I have tested and tested the code in your Workbook and it works great, but then I spotted, on the sheet TypicalData, there are no Headers in ROW1, when I add Headers, the code copies those to the DataHistory sheet??!!

Do you have a solution to this?

Once again, a very BIG thank you.

Ak

 

[DocAElstein]

I have tested and tested the code in your Workbook and it works great, but then I spotted, on the sheet TypicalData, there are no Headers in ROW1, when I add Headers, the code copies those to the DataHistory sheet??!!

Do you have a solution to this?

Sounds dead easy.

-Show me again exactly how your typical data should looks like, including headers (I saw no headers in your sample data)
-Or better still, if you are able, send me over FileSnack or box or whatever a file with sample data in it.

Alan

 

[Akashwani]

Hi Alan.

I hope this is ok....

Excel Workbook
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U	V	W	X	Y	Z	AA	AB	AC	AD	AE
1	Header1					Header2		Header3		Header4	Header5	Header6	Header7		Header8		Header9		Header10		Header11		Header12		Header13	Header14	Header15		Header16	Header17	Header18
2	U09575					860		126.42		140	132.94	0	8		154		90.3		1.19%		8.6		-116.79		0.163	-7.06	152.17		0.5	-56.07	19/08/2014
3	U09576					2561		326.53		280	343.67	0	8		134		116.62		-1.40%		8.5		395.39		0.109	63.674	135.87		0.5	-145.71	19/08/2014
4	U09659					3403		666.99		640	646.35	0	5		189.2		104.22		2.64%		2.1		56.67		0.188	6.3476	184.21		2.5	43.34	19/08/2014
5	U09875					2496		449.28		490	504.2	0	10		201		91.69		0.50%		4.8		-195.46		0.196	14.196	200		2.5	-263.60	19/08/2014
6	U09918					7302		1314.4		1370	1477.5	0	4		202		95.94		7.18%		11.73		-652.66		0.188	107.5	187.5		2.5	-1,913.68	19/08/2014
7	91204					934		44.83		46	114.72	0	0		122.5		97.46		60.82%		6.8		-7.94		0.049	68.715	48		0.3	-475.20	19/08/2014
8	42393					2221		124.38		128	316.33	0	0		142.2		97.17		60.62%		6.8		-24.64		0.058	188.33	56		0.5	-1,305.26	19/08/2014
9	42513					560		57.12		58	108.38	0	0		193		98.48		47.15%		7.52		-6.62		0.104	50.38	102		0.3	-385.48	19/08/2014
10	42510					2834		201.21		205	403.49	0	0		142.2		98.15		50.07%		6.8		-25.74		0.072	198.5	71		0.5	-1,375.51	19/08/2014
11	42392					1197		67.03		68	170.81	0	0		142.7		98.58		60.76%		2.23		-2.16		0.057	102.81	56		0	-231.12	19/08/2014
TypicalData

There wasn't any headers on my first example as I hid them whilst hiding none important rows/columns!

Thanks.

Ak

 

[DocAElstein]

Hi,
2 questions:

1. Do you always have headings in your Raw Data

2. Do you simply want the code to ignoor them and only copy the data
Alan

 

[Akashwani]

Hi Alan,

That will be a yes to both questions.

Ak

 

[DocAElstein]

Hi Alan,

That will be a yes to both questions.

Ak

Hi Akashwani
. Then it is really easy:

. If you take a look at my (Colorful!) code you will see the line

<font face=Calibri>        <SPAN style="color:#00007F">For</SPAN> NewDataRow = 1 <SPAN style="color:#00007F">To</SPAN> NewDataMaxRow <SPAN style="color:#00007F">Step</SPAN> 1 <SPAN style="color:#007F00">'Go through each new data value in the column...</SPAN></FONT>

. This tells the computer to go through every Row in the new data starting at 1 and stoping at the last entry. So simply change that 1 to a 2. It will then start at the second Row instead and ignor the first (Heading) Row.

I leave it to you as "Homework" to find the corresponding line correction in the Shortened program!!

Come back if I can help futher

Alan

 

[Akashwani]

EXCELLENT.
Thank you so much Alan, I really do appreciate your time, patience and work with this problmem.

For NewDataRow = 2 To Worksheets("TypicalData").Cells(Rows.Count, 1).End(xlUp).Row

That seems to work as well, BONUS!

Thanks again Alan.

Ak

 

[DocAElstein]

EXCELLENT.
Thank you so much Alan, I really do appreciate your time, patience and work with this problmem.

For NewDataRow = 2 To Worksheets("TypicalData").Cells(Rows.Count, 1).End(xlUp).Row

That seems to work as well, BONUS!

Thanks again Alan.

Ak

You're Welcome.

Come back anytime, especially with threads on any "sort of sorting". Maybe I'll catch them!

Alan