VBA Copy data to another workbook based on criteria

atame

New Member
Joined
May 26, 2015
Messages
31
Hi All,

I have a workbook that i would like to copy some data from, to another workbook. I need it to find all values greater than £0.01 in column L the copy the data from column B and L only to Workbook 2, sheet 1. Starting from A9. Everytime the button is clicked it need to clear all the data in workbook 2 below row 8, then paste the new data in. Once the data has been pasted, then save and close workbook 2. It will need to loop though the data as quantitys of data can change each month.

Workbook1, sheet "MergedData") contains data to be copied.

Workbook2, Sheet1, is where the data need to be copied, starting a A9.

I don't have any code so far, so am staring from scratch.

Any help will be greatly appreciated!!!

Thanks
Aarron
 
Hello,

have you tried the code I posted in #5 as this filters out the required data, so should copy the data in the same order.
 
Upvote 0

Excel Facts

Last used cell?
Press Ctrl+End to move to what Excel thinks is the last used cell.
@ onlyadrafter</SPAN></SPAN>
Hi onlyadrafter</SPAN></SPAN>



Hello,

have you tried the code I posted in #5 as this filters out the required data, so should copy the data in the same order.
......
<o:p></o:p>
<o:p> </o:p>
I did!<o:p></o:p>
. Works perfectly!!. <o:p></o:p>
. I am amazed how regulars like you answer so many Threads, so quickly, churning out codes like this that work first time.. AND that often working blind, or with missing info. I always need a good clear picture of what is going on. :pray: I guess with lots of experience you start “guessing”, as Excel does, what the user wants..<o:p></o:p>
. Yours makes my straggling attempt., well , “interesting!?!” But Threads with alternative solutions are always the best, my opinion.<o:p></o:p>
. Thanks for your contribution<o:p></o:p>
Alan<o:p></o:p>
.<o:p></o:p>
. P.s. the (1) in <o:p></o:p>
Workbooks("______").Close (1)<o:p></o:p>
.. --- that (1) says a) save and b) do not ask if you want to save it. ?? correct ?? ( could not quite google the exact answer to that..)<o:p></o:p>
Thanks<o:p></o:p>
Alan<o:p></o:p>
<o:p> </o:p>
................................<o:p></o:p>
@ atame<o:p></o:p>
Hi atame<o:p></o:p>
. I got an “interesting” alternative for you finished last night. I will post a bit later. Seems to work well. I want to tidy it up and explain the unusual Method a - bit, ( - for my amusement , if no one elses!! )<o:p></o:p>
Alan<o:p></o:p>
 
Upvote 0
Hi,

I look forward to seeing what you come up with. Thanks for the assistance.

...





Hi Aarron<o:p></o:p>
. Here’s the “interesting” alternative...<o:p></o:p>
. ( BTW. I just did a normal macro in module. I have never “done a Button”, but I think it is dead easy to assign a macro to a button; there are loads of “googles” on it; like this<o:p></o:p>
https://support.office.com/en-us/article/Add-a-button-and-assign-a-macro-to-it-in-a-worksheet-d58edd7d-cb04-4964-bead-9c72c843a283<o:p></o:p>
. ):<o:p></o:p>
. I tested it on made up files looking like this ( I put a header Row in , just as that is often useful, or sometimes needed, by VBA things )<o:p></o:p>
<o:p> </o:p>
Here again the initial data Workbook1<o:p></o:p>
<o:p> </o:p>
Using Excel 2007<o:p></o:p>
-
A
B
C
D
E
F
G
H
I
J
K
L
1
HA1​
HB1​
HC1​
HD1​
HE1​
HF1​
HG1​
HH1​
HI1​
HJ1​
HK1​
HL1​
2
5027801108721032 Fake House, Fake Road, FK1 1FK420608362083620
3
50278711787212 Fake House, Fake Road, FK1 1FK1301969.231969.2
4
5027861168725 Fake House, Fake Road, FK1 1FK91843.95843.95
5
5027901109723 Fake House, Fake Road, FK1 1FK45.5754.31754.31
<o:p></o:p>
MergedData
<o:p></o:p>

<o:p> </o:p>
...<o:p></o:p>
This is how the Booking (Workbook2) File looks..<o:p></o:p>
Before running the macro (But note it is closed before running the macro as the macro opens it)<o:p></o:p>
<o:p> </o:p>
Using Excel 2007<o:p></o:p>
-
A
B
1
Region Code:###
2
Accounts Ref:###
3
Sub Contractor Name:###
4
For Month Of:2015-05
5
Application Ref:2015-05
6
7
8
W/O Number
Total Net
9
<o:p></o:p>
Sheet1
<o:p></o:p>

<o:p> </o:p>
And then<o:p></o:p>
After running the macro<o:p></o:p>
<o:p> </o:p>
You get this<o:p></o:p>
<o:p> </o:p>
Using Excel 2007<o:p></o:p>
-
A
B
1
Region Code:###
2
Accounts Ref:###
3
Sub Contractor Name:###
4
For Month Of:2015-05
5
Application Ref:2015-05
6
7
8
W/O Number
Total Net
9
27801
83620
10
27871
1969.23
11
27861
843.95
12
27901
754.31
13
<o:p></o:p>
Sheet1
<o:p></o:p>

<o:p> </o:p>
<o:p> </o:p>
Here the code)s), first simplified a bit, then full with explain ‘green comments<o:p></o:p>
<o:p> </o:p>
Code:
<o:p></o:p>[/FONT][/COLOR]
[COLOR=gray][FONT=Verdana][color=lightgreen]'Option Explicit ' This must be commented out for simplified Code[/color]<o:p></o:p>[/FONT][/COLOR]
[COLOR=gray][FONT=Verdana][color=blue]Sub[/color] BringAndMergatameSHimpfGlified()<o:p></o:p>[/FONT][/COLOR]
[COLOR=gray][FONT=Verdana]<o:p> </o:p>[/FONT][/COLOR]
[COLOR=gray][FONT=Verdana][color=blue]Dim[/color] initworksheet [color=blue]As[/color] Worksheet: [color=blue]Set[/color] initworksheet = ActiveWorkbook.Sheets("MergedData")<o:p></o:p>[/FONT][/COLOR]
[COLOR=gray][FONT=Verdana][color=blue]Dim[/color] arrin(): arrin() = initworksheet.Range("A2:L" & Cells(Rows.Count, 12).End(xlUp).Row).Value<o:p></o:p>[/FONT][/COLOR]
[COLOR=gray][FONT=Verdana][color=blue]Dim[/color] x(): x() = Application.WorksheetFunction.Transpose(Application.WorksheetFunction.Index(arrin(), 0, 12))<o:p></o:p>[/FONT][/COLOR]
[COLOR=gray][FONT=Verdana]       [color=blue]For[/color] iii = [color=blue]LBound[/color](x()) [color=blue]To[/color] [color=blue]UBound[/color](x())<o:p></o:p>[/FONT][/COLOR]
[COLOR=gray][FONT=Verdana]           [color=blue]If[/color] x(iii) >= 0.01 [color=blue]Then[/color] strRows = strRows & " " & iii<o:p></o:p>[/FONT][/COLOR]
[COLOR=gray][FONT=Verdana]       [color=blue]Next[/color] iii<o:p></o:p>[/FONT][/COLOR]
[COLOR=gray][FONT=Verdana]    [color=blue]Dim[/color] rws() [color=blue]As[/color] String: rws() = Split(Trim(strRows), " ")<o:p></o:p>[/FONT][/COLOR]
[COLOR=gray][FONT=Verdana]    [color=blue]Let[/color] strRows = ""<o:p></o:p>[/FONT][/COLOR]
[COLOR=gray][FONT=Verdana]    [color=blue]Dim[/color] clms() [color=blue]As[/color] Variant: clms() = Evaluate("row(1:" & [color=blue]UBound[/color](arrin(), 2) & ")")<o:p></o:p>[/FONT][/COLOR]
[COLOR=gray][FONT=Verdana]    [color=blue]Dim[/color] y(): y() = Application.WorksheetFunction.Transpose(Application.Index(arrin(), rws(), clms()))<o:p></o:p>[/FONT][/COLOR]
[COLOR=gray][FONT=Verdana]<o:p> </o:p>[/FONT][/COLOR]
[COLOR=gray][FONT=Verdana]    [color=blue]Dim[/color] c(): c() = Array("2", "12"): [color=blue]Let[/color] c() = Application.WorksheetFunction.Transpose(c())<o:p></o:p>[/FONT][/COLOR]
[COLOR=gray][FONT=Verdana]       [color=blue]For[/color] iii = [color=blue]LBound[/color](y(), 1) [color=blue]To[/color] [color=blue]UBound[/color](y(), 1)<o:p></o:p>[/FONT][/COLOR]
[COLOR=gray][FONT=Verdana]           strRows = strRows & " " & iii<o:p></o:p>[/FONT][/COLOR]
[COLOR=gray][FONT=Verdana]       [color=blue]Next[/color] iii<o:p></o:p>[/FONT][/COLOR]
[COLOR=gray][FONT=Verdana]    [color=blue]Dim[/color] r() [color=blue]As[/color] String: [color=blue]Let[/color] r() = Split(Trim(strRows), " ")<o:p></o:p>[/FONT][/COLOR]
[COLOR=gray][FONT=Verdana]    [color=blue]Dim[/color] outArr() [color=blue]As[/color] Variant: [color=blue]Let[/color] outArr() = Application.WorksheetFunction.Transpose(Application.Index(y(), r(), c()))<o:p></o:p>[/FONT][/COLOR]
[COLOR=gray][FONT=Verdana]<o:p> </o:p>[/FONT][/COLOR]
[COLOR=gray][FONT=Verdana]<o:p> </o:p>[/FONT][/COLOR]
[COLOR=gray][FONT=Verdana][color=blue]Dim[/color] myData [color=blue]As[/color] Workbook<o:p></o:p>[/FONT][/COLOR]
[COLOR=gray][FONT=Verdana][color=blue]Set[/color] myData = Workbooks.Open(ActiveWorkbook.Path & "\Bookings.xls")<o:p></o:p>[/FONT][/COLOR]
[COLOR=gray][FONT=Verdana][color=blue]Set[/color] myData = Workbooks("Bookings")<o:p></o:p>[/FONT][/COLOR]
[COLOR=gray][FONT=Verdana][color=blue]Dim[/color] destworksheet [color=blue]As[/color] Worksheet: [color=blue]Set[/color] destworksheet = myData.Sheets("Sheet1")<o:p></o:p>[/FONT][/COLOR]
[COLOR=gray][FONT=Verdana]destworksheet.Range("A9").Resize(UBound(outArr(), 1), UBound(outArr(), 2)).Value = outArr()<o:p></o:p>[/FONT][/COLOR]
[COLOR=gray][FONT=Verdana]myData.Close (1)<o:p></o:p>[/FONT][/COLOR]
[COLOR=gray][FONT=Verdana][color=blue]End[/color] [color=blue]Sub[/color]
<o:p></o:p>
<o:p> </o:p>
……………………………..<o:p></o:p>
<o:p> </o:p>
Code:
[color=blue]Option[/color] [color=blue]Explicit[/color]<o:p></o:p>[/FONT][/COLOR]
[COLOR=gray][FONT=Verdana][color=blue]Sub[/color] BringAndMergatame()<o:p></o:p>[/FONT][/COLOR]
[COLOR=gray][FONT=Verdana][color=lightgreen]' 1) Get Initial Data for Output to Bookings.xls[/color]<o:p></o:p>[/FONT][/COLOR]
[COLOR=gray][FONT=Verdana][color=blue]Dim[/color] initworksheet [color=blue]As[/color] Worksheet [color=lightgreen]'Give Abbreviation Methods, Properties of Object Worksheet through .dot[/color]<o:p></o:p>[/FONT][/COLOR]
[COLOR=gray][FONT=Verdana][color=blue]Set[/color] initworksheet = ActiveWorkbook.Sheets("MergedData") [color=lightgreen]'Assumes Workbook1 is open and Active[/color]<o:p></o:p>[/FONT][/COLOR]
[COLOR=gray][FONT=Verdana][color=blue]Dim[/color] lmr [color=blue]As[/color] [color=blue]Long[/color], lmc [color=blue]As[/color] [color=blue]Long[/color] [color=lightgreen]'Variable for Rows, Columns, last Row last Column of merged sheet. Assume our File for Input has a reasonably well defined end. Long is a Big whole Number limit (-2,147,483,648 to 2,147,483,647) If you need some sort of validation the value should only be within the range of a Byte/Integer otherwise there's no point using anything but Long.--upon/after 32-bit, Integers (Short) need converted internally anyways, so a Long is actually faster.[/color]<o:p></o:p>[/FONT][/COLOR]
[COLOR=gray][FONT=Verdana][color=blue]Let[/color] lmc = 12: [color=blue]Let[/color] lmr = initworksheet.Cells.Find(What:="*", After:=initworksheet.Cells(1, 1), Lookat:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row [color=lightgreen]'Get last Row with entry anywhere for Sheet1. Method: You start at first cell then go backwards (which effectively starts at end of sheet), searching for anything ( = * ) by rows, then get the row number. This allows for different excel versions with different available Row numbers) Just a different method that finds last row in sheet rather than row for last entry in particular cell. Better to use that here as we are not sure which columns are full[/color]<o:p></o:p>[/FONT][/COLOR]
[COLOR=gray][FONT=Verdana][color=blue]Dim[/color] arrin() [color=blue]As[/color] Variant: [color=blue]Let[/color] arrin() = initworksheet.Range(initworksheet.Cells(2, 1), initworksheet.Cells(lmr, lmc)).Value [color=lightgreen]'Allowed VBA One Liner - An Array of variants may be set to a collection of Range values. The Range object works as to return a collection of (Variants initially) of various types. So Initially must see an Array of Variant types for compatability[/color]<o:p></o:p>[/FONT][/COLOR]
[COLOR=gray][FONT=Verdana]<o:p> </o:p>[/FONT][/COLOR]
[COLOR=gray][FONT=Verdana][color=lightgreen]' 2) Obtain a  I dimensional "pseudo" horizontal Array of LookUpColumn[/color]<o:p></o:p>[/FONT][/COLOR]
[COLOR=gray][FONT=Verdana][color=blue]Dim[/color] vLkUpc [color=blue]As[/color] Long: [color=blue]Let[/color] vLkUpc = 12 [color=lightgreen]'set column number 'Column where search criteria for filtering is. '( Long is a Big whole Number limit (-2,147,483,648 to 2,147,483,647) If you need some sort of validation the value should only be within the range of a Byte/Integer otherwise there's no point using anything but Long.--upon/after 32-bit, Integers (Short) need converted internally anyways, so a Long is actually faster.[/color]<o:p></o:p>[/FONT][/COLOR]
[COLOR=gray][FONT=Verdana]    [color=blue]Dim[/color] x() [color=blue]As[/color] [color=blue]Variant[/color] [color=lightgreen]'Dynamic one dimensional array for lookUpColumn[/color]<o:p></o:p>[/FONT][/COLOR]
[COLOR=gray][FONT=Verdana]    [color=blue]Let[/color] x() = Application.WorksheetFunction.Index(arrin(), 0, vLkUpc) [color=lightgreen]'Returns format type (1,1) (2,1) (3,1) (4,1) >> Index Function with second argument (row co - ordinate) set to 0 will return the entire row given by first argument ( row - co ordinate ), applied to the first argument which is the grid, ( Array , Row_Number, Column_Number)  http://www.excelforum.com/excel-new-users-basics/1080634-vba-1-dimensional-horizontal-and-vertical-array-conventions-ha-1-2-3-4-a.html[/color]<o:p></o:p>[/FONT][/COLOR]
[COLOR=gray][FONT=Verdana]    [color=blue]Let[/color] x() = Application.WorksheetFunction.Transpose(x()) [color=lightgreen]'working on 2 dimensional array of one column, conveniently by convenience returns 'Returns format type (1) (2) (3) (4) , a one dimension "psuedo" horizontal Array[/color]<o:p></o:p>[/FONT][/COLOR]
[COLOR=gray][FONT=Verdana]<o:p> </o:p>[/FONT][/COLOR]
[COLOR=gray][FONT=Verdana][color=lightgreen]' 3) Obtain an Array of indicies for rows meeting criteria for sort, and all colimn Indicies.[/color]<o:p></o:p>[/FONT][/COLOR]
[COLOR=gray][FONT=Verdana][color=blue]Dim[/color] strRows [color=blue]As[/color] [color=blue]String[/color] [color=lightgreen]'Used as Temporary concatenated string fo row indicies[/color]<o:p></o:p>[/FONT][/COLOR]
[COLOR=gray][FONT=Verdana]    [color=blue]Dim[/color] iii [color=blue]As[/color] [color=blue]Long[/color] [color=lightgreen]'Loop Bound (Count) variable[/color]<o:p></o:p>[/FONT][/COLOR]
[COLOR=gray][FONT=Verdana]       [color=blue]For[/color] iii = [color=blue]LBound[/color](x()) [color=blue]To[/color] [color=blue]UBound[/color](x()) [color=lightgreen]'Lower Bound by me is start of data[/color]<o:p></o:p>[/FONT][/COLOR]
[COLOR=gray][FONT=Verdana]           [color=blue]If[/color] x(iii) >= 0.01 [color=blue]Then[/color] strRows = strRows & " " & iii [color=lightgreen]'Concatenating valid "row" indicies[/color]<o:p></o:p>[/FONT][/COLOR]
[COLOR=gray][FONT=Verdana]       [color=blue]Next[/color] iii<o:p></o:p>[/FONT][/COLOR]
[COLOR=gray][FONT=Verdana]       [color=blue]Let[/color] strRows = Trim(strRows) [color=lightgreen]'trim off first space[/color]<o:p></o:p>[/FONT][/COLOR]
[COLOR=gray][FONT=Verdana]    [color=blue]Dim[/color] rws() [color=blue]As[/color] String: [color=blue]Let[/color] rws() = Split(strRows, " ")  [color=lightgreen]'Finally rws becomes a 1 dimension1 "Psuedo" horizontal Array of the selected row inicia. The space is default, so " " could be ommited.. Split is a strings function usually returnig a String - Dim rws as variant would work , but not  Dim rws() as variant   From Post 48   http://www.excelforum.com/excel-new-users-basics/1058406-range-dimensioning-range-and-value-referencing-and-referring-to-arrays-4.html[/color]<o:p></o:p>[/FONT][/COLOR]
[COLOR=gray][FONT=Verdana]    [color=blue]Let[/color] strRows = "" [color=lightgreen]'Finished with using temporary concatenated indicie values so empty it ready for next looping[/color]<o:p></o:p>[/FONT][/COLOR]
[COLOR=gray][FONT=Verdana]    [color=blue]Dim[/color] clms() [color=blue]As[/color] Variant: [color=blue]Let[/color] clms() = Evaluate("row(1:" & [color=blue]UBound[/color](arrin(), 2) & ")") [color=lightgreen]' 'Returns 1 column 2 dimensional array of size _: to :_  In that array are the number _:   to :_[/color]<o:p></o:p>[/FONT][/COLOR]
[COLOR=gray][FONT=Verdana][color=lightgreen]' 4 ) Obtain Full Column Output Array based on "row" selection criteria[/color]<o:p></o:p>[/FONT][/COLOR]
[COLOR=gray][FONT=Verdana]    [color=blue]Dim[/color] y() [color=blue]As[/color] [color=blue]Variant[/color] [color=lightgreen]'I believe here the Index is working in some "vector" type form here. VBA "works" as follows here:[/color]<o:p></o:p>[/FONT][/COLOR]
[COLOR=gray][FONT=Verdana]    [color=blue]Let[/color] y() = Application.Index(arrin(), rws(), clms()) [color=lightgreen]'It takes in turn each of the indicies in rws()[/color]<o:p></o:p>[/FONT][/COLOR]
[COLOR=gray][FONT=Verdana]    [color=lightgreen]'and for each of these it steps through the indicies in clms(). It returns then effectively a "column" of values.[/color]<o:p></o:p>[/FONT][/COLOR]
[COLOR=gray][FONT=Verdana]    [color=lightgreen]' These values are then the entities in the main Array arrin() given by those co-ordinates. In our case then, we initially put into the new Array y(), a column which contains the first data row.[/color]<o:p></o:p>[/FONT][/COLOR]
[COLOR=gray][FONT=Verdana]    [color=blue]Let[/color] y() = Application.WorksheetFunction.Transpose(y()) [color=lightgreen]'...As this process is then repeated for all the indicies given in  rws() we effectively have an Array  y() of our required output rows , but transposed. ( so we transpose it back to the correct orientation! )[/color]<o:p></o:p>[/FONT][/COLOR]
[COLOR=gray][FONT=Verdana][color=lightgreen]' 5 )obtain an Array of indicies for required output columns and all "row" indices[/color]<o:p></o:p>[/FONT][/COLOR]
[COLOR=gray][FONT=Verdana]    [color=blue]Dim[/color] c() [color=blue]As[/color] Variant: [color=blue]Let[/color] c() = Array("2", "12"): [color=blue]Let[/color] c() = Application.WorksheetFunction.Transpose(c())<o:p></o:p>[/FONT][/COLOR]
[COLOR=gray][FONT=Verdana]       [color=blue]For[/color] iii = [color=blue]LBound[/color](y(), 1) [color=blue]To[/color] [color=blue]UBound[/color](y(), 1) [color=lightgreen]'Lower Bound by me is start of data[/color]<o:p></o:p>[/FONT][/COLOR]
[COLOR=gray][FONT=Verdana]           strRows = strRows & " " & iii [color=lightgreen]'Concatenating valid "row" indicies[/color]<o:p></o:p>[/FONT][/COLOR]
[COLOR=gray][FONT=Verdana]       [color=blue]Next[/color] iii<o:p></o:p>[/FONT][/COLOR]
[COLOR=gray][FONT=Verdana]        [color=blue]Let[/color] strRows = Trim(strRows) [color=lightgreen]'trim off first space[/color]<o:p></o:p>[/FONT][/COLOR]
[COLOR=gray][FONT=Verdana]    [color=blue]Dim[/color] r() [color=blue]As[/color] String: [color=blue]Let[/color] r() = Split(strRows, " ")<o:p></o:p>[/FONT][/COLOR]
[COLOR=gray][FONT=Verdana][color=lightgreen]' 6 ) Obtain output Array with required Columns[/color]<o:p></o:p>[/FONT][/COLOR]
[COLOR=gray][FONT=Verdana]    [color=blue]Dim[/color] outArr() [color=blue]As[/color] Variant: [color=blue]Let[/color] outArr() = Application.WorksheetFunction.Transpose(Application.Index(y(), r(), c())) [color=lightgreen]'Same procedure as for getting Y() but in one SHimpfGlified[/color]<o:p></o:p>[/FONT][/COLOR]
[COLOR=gray][FONT=Verdana]<o:p> </o:p>[/FONT][/COLOR]
[COLOR=gray][FONT=Verdana][color=lightgreen]' 7 ) Open Bookungs Workbook[/color]<o:p></o:p>[/FONT][/COLOR]
[COLOR=gray][FONT=Verdana][color=blue]Dim[/color] myData [color=blue]As[/color] Workbook [color=lightgreen]'Give Abbreviation Methods, Properties of Object Workbook through .dot[/color]<o:p></o:p>[/FONT][/COLOR]
[COLOR=gray][FONT=Verdana][color=blue]Set[/color] myData = Workbooks.Open(ActiveWorkbook.Path & "\Bookings.xls") [color=lightgreen]'Workbooks.Open returns a Workbook object so we can imediately set our variable for this workbook to it in one neat line[/color]<o:p></o:p>[/FONT][/COLOR]
[COLOR=gray][FONT=Verdana][color=blue]Dim[/color] destworksheet [color=blue]As[/color] Worksheet: [color=blue]Set[/color] destworksheet = myData.Sheets("Sheet1") [color=lightgreen]'Shheet for output[/color]<o:p></o:p>[/FONT][/COLOR]
[COLOR=gray][FONT=Verdana][color=lightgreen]' 8 ) Output results[/color]<o:p></o:p>[/FONT][/COLOR]
[COLOR=gray][FONT=Verdana][color=blue]Let[/color] destworksheet.Range("A9").Resize(UBound(outArr(), 1), UBound(outArr(), 2)).Value = outArr()  [color=lightgreen]'A nice "One" liner - Resize selected cell to size of output Array and then the allowed VBA assignment of a collection of values to a Spreadsheet range[/color]<o:p></o:p>[/FONT][/COLOR]
[COLOR=gray][FONT=Verdana][color=lightgreen]'Save and close workbook[/color]<o:p></o:p>[/FONT][/COLOR]
[COLOR=gray][FONT=Verdana][color=lightgreen]'myData.Save'Save only[/color]<o:p></o:p>[/FONT][/COLOR]
[COLOR=gray][FONT=Verdana]myData.Close (1)<o:p></o:p>[/FONT][/COLOR]
[COLOR=gray][FONT=Verdana]<o:p> </o:p>[/FONT][/COLOR]
[COLOR=gray][FONT=Verdana][color=blue]End[/color] [color=blue]Sub[/color] [color=lightgreen]'BringAndMergatame()[/color]<o:p></o:p>[/FONT][/COLOR]
[COLOR=gray][FONT=Verdana][color=lightgreen]'[/color]
<o:p></o:p>
<o:p> </o:p>
<o:p> </o:p>
<o:p> </o:p>
Brief Code description:<o:p></o:p>
. 1 ) Input data is put in an Array, ( arrin() ). After this all workings are done “inside” VBA and no further interaction with worksheet until outputting results..<o:p></o:p>
. 2 ) Obtain a I dimensional “pseudo” horizontal Array of column L values<o:p></o:p>
.3 ) Obtain a I dimensional “pseudo” horizontal Array filled with indicies for valid “rows” ( L >0.01), and a 1 column 2 dimensional array full with all indicies for all columns<o:p></o:p>
.4 ) Effectively uses the Index Function in a simple one liner ( Several lines are actually used here just to “open it up” a bit and see what is going on )<o:p></o:p>
. . I believe the Index is working in some “vector” type form here. VBA “works” as follows here:<o:p></o:p>
. It takes in turn each of the indicies in rws() and for each of these it steps through the indicies in clms(). It returns then effectively a “column” of values. <o:p></o:p>
(This is just the “way” VBA was once programmed to work…but nobody living can actually remember doing it or wrote down anywhere what they did, I think!?!? ) <o:p></o:p>
. These values are then the entities in the main Array arrin() given by those co-ordinates. In our case then, we initially put into the new Array y(), a column which contains the first data row.<o:p></o:p>
. As this process is then repeated for all the indicies given in rws() we effectively have an Array y() of our required output rows , but transposed. ( so we transpose it back to the correct orientation! )<o:p></o:p>
. In most applications of this type where the entire Row with all columns are required we would be finished here. But we want to select specific Columns, so<o:p></o:p>
.5) Similar to .3) but we obtain all “row” indicies and just the required “column” indices<o:p></o:p>
. 6) Similar to .4) to produce the final Output Array, using the Index Function with first argument ( Grid ) as the Full output Array ( y() ) and the “rows” and “column” indicies given by .5) <o:p></o:p>
. 7) Open the File where the output goes<o:p></o:p>
.8 ) Output results to file, save, close it.<o:p></o:p>
 
Upvote 0
. Hi,<o:p></o:p>
. No one checked my deliberate mistake.. so here the sihmpligfied code with just the single necessary loop. <o:p></o:p>
<o:p> </o:p>
Code:
[color=lightgreen]'Option   Explicit   '   This   must   be   commented   out   for   simplified   Code[/color]<o:p></o:p>[/FONT][/COLOR]
[COLOR=gray][FONT=Arial][color=blue]Sub[/color]   BringAndMergatameSHimpfGlified2()<o:p></o:p>[/FONT][/COLOR]
[COLOR=gray][FONT=Arial][color=lightgreen]'[/color]<o:p></o:p>[/FONT][/COLOR]
[COLOR=gray][FONT=Arial][color=blue]Dim[/color]   initworksheet   [color=blue]As[/color]   Worksheet:   [color=blue]Set[/color]   initworksheet   =   ActiveWorkbook.Sheets("MergedData")<o:p></o:p>[/FONT][/COLOR]
[COLOR=gray][FONT=Arial][color=blue]Dim[/color]   arrin():   arrin()   =   initworksheet.Range("A2:L"   &   Cells(Rows.Count,   12).End(xlUp).Row).Value<o:p></o:p>[/FONT][/COLOR]
[COLOR=gray][FONT=Arial][color=blue]Dim[/color]   x():   x()   =   Application.WorksheetFunction.Transpose(Application.WorksheetFunction.Index(arrin(),   0,   12))<o:p></o:p>[/FONT][/COLOR]
[COLOR=gray][FONT=Arial]                     [color=blue]For[/color]   iii   =   [color=blue]LBound[/color](x())   [color=blue]To[/color]   [color=blue]UBound[/color](x())<o:p></o:p>[/FONT][/COLOR]
[COLOR=gray][FONT=Arial]                                 [color=blue]If[/color]   x(iii)   >=   0.01   [color=blue]Then[/color]   strRows   =   strRows   &   "   "   &   iii<o:p></o:p>[/FONT][/COLOR]
[COLOR=gray][FONT=Arial]                     [color=blue]Next[/color]   iii<o:p></o:p>[/FONT][/COLOR]
[COLOR=gray][FONT=Arial]            [color=blue]Dim[/color]   rws()   [color=blue]As[/color]   String:   rws()   =   Split(Trim(strRows),   "   ")<o:p></o:p>[/FONT][/COLOR]
[COLOR=gray][FONT=Arial]            [color=blue]Dim[/color]   clms()   [color=blue]As[/color]   Variant:   clms()   =   Application.Transpose(Array("2",   "12"))<o:p></o:p>[/FONT][/COLOR]
[COLOR=gray][FONT=Arial]            [color=blue]Dim[/color]   y():   y()   =   Application.Transpose(Application.Index(arrin(),   rws(),   clms()))<o:p></o:p>[/FONT][/COLOR]
[COLOR=gray][FONT=Arial][color=lightgreen]'[/color]<o:p></o:p>[/FONT][/COLOR]
[COLOR=gray][FONT=Arial][color=blue]Dim[/color]   myData   [color=blue]As[/color]   Workbook:   [color=blue]Set[/color]   myData   =   Workbooks.Open(ActiveWorkbook.Path   &   "\Bookings.xls")<o:p></o:p>[/FONT][/COLOR]
[COLOR=gray][FONT=Arial][color=blue]Dim[/color]   destworksheet   [color=blue]As[/color]   Worksheet:   [color=blue]Set[/color]   destworksheet   =   myData.Sheets("Sheet1")<o:p></o:p>[/FONT][/COLOR]
[COLOR=gray][FONT=Arial]destworksheet.Range("A9").Resize(UBound(y(),   1),   UBound(y(),   2)).Value   =   y()<o:p></o:p>[/FONT][/COLOR]
[COLOR=gray][FONT=Arial]myData.Close   (1)<o:p></o:p>[/FONT][/COLOR]
[COLOR=gray][FONT=Arial][color=blue]End[/color]   [color=blue]Sub[/color]
<o:p></o:p>
 
Upvote 0

Forum statistics

Threads
1,215,223
Messages
6,123,714
Members
449,118
Latest member
MichealRed

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top