[color=blue]Sub[/color] Reorgwhcmelvin()
[color=lightgreen]'1) Some Initial Object setting, variables and initial data capture too Array- usin VBA Array mehtod, minimising interaction with spreadsheet[/color]
[color=blue]Dim[/color] ws [color=blue]As[/color] Worksheet: [color=blue]Set[/color] ws = ThisWorkbook.Worksheets("whcmelvin") [color=lightgreen]'Give abreviation method, properies etc. of worksheets object obtained by typing .[/color]
[color=blue]Dim[/color] arrIn() [color=blue]As[/color] Variant: [color=blue]Let[/color] arrIn() = ws.Range("A1").CurrentRegion.Value [color=lightgreen]'Dynamic Array for "Capture" of Spreadsheet, using the VBA allowed "one liner" to assign an Array to values of cells in a range. So must be a variant as it sees the Range object as it is assigned a collection[/color]
[color=blue]Dim[/color] arrOut() [color=blue]As[/color] [color=blue]String[/color] [color=lightgreen]'This is a non Dynamic array to have values asigned in a loop, so we can define it#s type. Here String ic conveniant for names and numbers.[/color]
[color=blue]ReDim[/color] arrOut(1 [color=blue]To[/color] (UBound(arrIn(), 1)) - 1, 1 [color=blue]To[/color] 1) [color=lightgreen]'Must give the output Array a size or we cannot use it later. For now, make it maximuum possible size it could be. Must use reDim as Dim only takes numbers, not variables[/color]
[color=lightgreen]'2) Use Dictionary (Keys only ( var=.item method ) ) to get eunuch values (keys) of VlookUp Column A----------------------------------------[/color]
[color=lightgreen]' For "Early binding"--requires library reference to MS Scripting Runtime - Tools>>References>>scrolldown and check the box next to Microsoft Scripting Runtime[/color]
[color=lightgreen]' ..Or crashes at next line.....---[/color]
[color=lightgreen]'[color=blue]Dim[/color] dicLookupTable As Scripting.Dictionary 'Data held with a unique "Key"or Part Number.[/color]
[color=lightgreen]'Set dicLookupTable = New Scripting.Dictionary[/color]
[color=lightgreen]' The next two lines are an alternative called Late binding. (But note some Dictionary methods and properties[/color]
[color=blue]Dim[/color] dicLookupTable [color=blue]As[/color] [color=blue]Object[/color]
[color=blue]Set[/color] dicLookupTable = CreateObject("Scripting.Dictionary")
[color=lightgreen]' Late Binding is better when sharing files as I am here. Early Binding has the advantage that Excel intellisense[/color]
[color=lightgreen]' will then work for the Microsoft Scripüting Runtime stuff and give you suggestions after you type the .dot thing[/color]
dicLookupTable.CompareMode = vbTextCompare [color=lightgreen]'Not quite sure wot this does yet[/color]
[color=blue]Dim[/color] runc [color=blue]As[/color] [color=blue]Long[/color] [color=lightgreen]'Loop Bound Variable (Count) http://www.mrexcel.com/forum/excel-questions/803662-byte-backward-loop-4.html[/color]
[color=lightgreen]' The method =.Item() works in a nice way that allows us to make unique keys without assigning items http://www.snb-vba.eu/VBA_Dictionary_en.html[/color]
[color=lightgreen]' -- Usually the method .Item() is used to assign an item of some unique key to a vaiable. z = dicLookupTable.Item(x(i). If the key does not exist then it is made...convenient ehh?--- ( and no value will be given to the variable )[/color]
[color=blue]Dim[/color] z [color=blue]As[/color] [color=blue]Variant[/color] [color=lightgreen]'Subtle dimensioning reason... in method =.Item() z becomes empty "" "No value is given??" snb?? Post #12 http://www.excelforum.com/excel-programming-vba-macros/1083899-copy-and-paste-entire-row-to-second-sheet-based-on-cell-value.html[/color]
[color=blue]For[/color] runc = [color=blue]LBound[/color](arrIn()) + 1 [color=blue]To[/color] [color=blue]UBound[/color](arrIn()) [color=lightgreen]'Start looking down column at row 2 so as not to get the heading is first dic item[/color]
z = dicLookupTable.Item(arrIn(runc, 1)) [color=lightgreen]'You will not see anything here: Post #7 http://www.excelforum.com/excel-programming-vba-macros/1083899-copy-and-paste-entire-row-to-second-sheet-based-on-cell-value.html[/color]
[color=blue]Next[/color] runc
Dim Uniques() [color=blue]As[/color] Variant: [color=blue]Let[/color] Uniques() = dicLookupTable.keys [color=lightgreen]' The unique keys are put into a 1 Dimensional Dynamic array called zz. Probably again the variant is needed as it sees the Dictionarry object initially, the usual "one liner" type assignment[/color]
[color=lightgreen]' Dim rResults() As Variant: Let rResults() = dicLookupTable.Items() 'Extra line helpful to examine items in watch window... as dicLookupTable in watch window just the keys!! and a limited number thereof http://www.mrexcel.com/forum/excel-questions/832103-using-microsoft-scripting-runtime-dictionary-store-then-retrieve-range-objects-2.html[/color]
[color=lightgreen]'End of Part 2 initial set up Of MRSD and use of keys to get unique values ---------------------[/color]
[color=lightgreen]'3)Put Unique names in Array for output ( could do that later in the main loop, .. but in VBA Array things go quick so WTF )[/color]
[color=blue]ReDim[/color] arrOut(1 [color=blue]To[/color] (UBound(Uniques()) + 1), 1 [color=blue]To[/color] ([color=blue]UBound[/color](arrIn(), 1) - 1)) [color=lightgreen]'Must give the output Array a size or we cannot use it later. At this point we know it's rows", but not the columns..make it maximuum possible size it could be - if 1 person did everything. Must use re[color=blue]Dim[/color] as Dim only takes numbers, not variables[/color]
[color=blue]For[/color] runc = [color=blue]LBound[/color](Uniques()) [color=blue]To[/color] [color=blue]UBound[/color](Uniques()) [color=lightgreen]'take each unique name "row"[/color]
[color=blue]Let[/color] arrOut(runc + 1, 1) = Uniques(runc) [color=lightgreen]'Put in name in output Array..Note the +1, is because first indicie in Uniques array is made 0 by VBA[/color]
[color=blue]Next[/color] runc
[color=lightgreen]'4) Main Looping to make Array for output..[/color]
Dim rws [color=blue]As[/color] [color=blue]Long[/color], cout [color=blue]As[/color] [color=blue]Long[/color] [color=lightgreen]' "Rows" of Input Array, and "columns" of output Array,[/color]
[color=blue]For[/color] runc = [color=blue]LBound[/color](Uniques()) [color=blue]To[/color] [color=blue]UBound[/color](Uniques()) [color=lightgreen]'take each unique name "row"[/color]
[color=blue]Let[/color] cout = 1 [color=lightgreen]'Set the "column" for any output to the Out Array as 1 (actually at Name "column")[/color]
[color=blue]For[/color] rws = 2 [color=blue]To[/color] UBound(arrIn(), 1) [color=lightgreen]'go down input "row"[/color]
[color=blue]If[/color] arrIn(rws, 1) = Uniques(runc) [color=blue]Then[/color] [color=lightgreen]'If the current name looking for is in column A, then[/color]
[color=blue]Let[/color] cout = cout + 1 [color=lightgreen]'goto next empty column in Output Array and[/color]
[color=blue]Let[/color] arrOut(runc + 1, cout) = arrIn(rws, 2) [color=lightgreen]'[/color]
[color=blue]Else[/color] 'redundant code: have not found a List type yet
[color=blue]End[/color] [color=blue]If[/color]
[color=blue]Next[/color] rws
[color=blue]Next[/color] runc
[color=lightgreen]'5) Output to sheet ( and delete initial data )[/color]
[color=blue]Let[/color] ws.Range("A1").Resize(1, 4).Value = Array("Name", "Sports", "Name", "Sports") [color=lightgreen]'A typical step that looks cleverer then it is, I resize first cell to a range including all headings I want, and then VBA lets me assign the values in a (Heasding here) Array to the cells in a simple = step[/color]
[color=blue]Let[/color] ws.Range("C2").Resize(UBound(arrOut(), 1), UBound(arrOut(), 2)).Value = arrOut() [color=lightgreen]'Similat to the above just convenient to resize to size of Arrray i am actually outputing ( Assuming there are more than one value of the Uniques then I output empty values also, but that is useful as it actually clears those cells in case they had any in from a last run where there were more in the output Array[/color]
[color=lightgreen]'ws.Columns("A:B").Delete[/color]
[color=blue]End[/color] [color=blue]Sub[/color] [color=lightgreen]'Reorgwhcmelvin()[/color]
