Hi,
Lesson 2 in Posting at Mr Excel
. It
is a good idea usually to reply with the „Reply With Quote“ Button . That way everyone keeps track of who is talking to who. ( Some Board Regulars do not do that and it is a pain sometimes keeping track of who is answering who and in / to which Post. So you should usually
Always do it and
always include a bit of the original message, …..
But only enough to make it clear who you are talking to and about what – so shorten it to the minimum necessary. Otherwise you clutter up the thread again with crap. The mods are all much too busy these days doing the real work to tidy your mess up )
. so for example..
This would have done.. ( you simply chop bits out )
[QUOTE="DocAElstein, post: 4169737, member: 286762"]…….
. I really cannot make head or tail of wot you want…..
. …… practice posting in the test area
[URL="http://www.mrexcel.com/forum/test-here/"]Test Here[/URL]
…….
I ‘aint going to waste my time unless You give me a clear [B]„BEFORE“[/B] and [B]“AFTER”[/B] as I explained before……...[/QUOTE]
…. Then I reply to Yous as follows
[QUOTE="tolga, post: 4169864, member: 327872"].....worked in test and it's awesome!......
before: you have type1, type2 etc. the word type indicates that it's the start of a series. the 1 and the 2 are unique type values that contain various items like apples, oranges, pears, bear and lube.
...........................
after: only the first series of the unique types are left with their relative contents and duplicate types with their contents are taken out. so type1 and type2 are gone and so are the bear and the lube. thank goodness for that! duplicates are disregarded as far as contents within types. so basically I need first "types" and their contents out of a given column. let's say column c or something. what to do and how to do?....[/QUOTE]
Which comes out in the post like this…. And then I start to answer..
.....worked in test and it's awesome!......
before: you have type1, type2 etc. the word type indicates that it's the start of a series. the 1 and the 2 are unique type values that contain various items like apples, oranges, pears, bear and lube.
...........................
after: only the first series of the unique types are left with their relative contents and duplicate types with their contents are taken out. so type1 and type2 are gone and so are the bear and the lube. thank goodness for that! duplicates are disregarded as far as contents within types. so basically I need first "types" and their contents out of a given column. let's say column c or something. what to do and how to do?....
….
. So here it comes, My answer / response…
. This sounds a strange requirement .. just taking the first occurrence of any type and just ignoring further types
and their content.. I mean it’s harmless fun with the Bear, and , honestly I’m sure he enjoys it. And it is only because the wife is away for a few days….
. This problem sounds very easy from the VBA side.
It is probably a case of getting your data structured carefully. I hope you are sure of your requirement, and
do not, for example, want a list of all Unique types with all the sort of contents that could be in them gathered from you entire list. (so then you
would want the Bear and the lube in it’s appropriate Unique list in the output ) - The Bear will be nervous, if that is the case, as it is then not a case of modifying the following code, but a case of starting from scratch, wasting any effort getting the following code. - The Bear may suffer then….
…………..
………………………………………………..
Anyways
. This code does basically what you asked for in your
Before and
After. ( For no particular reason I have input (
Before ) in Column A and Output (
After ) in column G.
. You start like this:
Using Excel 2007
- | A | B |
1 | | |
2 | type1 | |
3 | apples | |
4 | oranges | |
5 | pears | |
6 | type2 | |
7 | apples | |
8 | apples | |
9 | apples | |
10 | type1 | |
11 | bear | |
12 | type2 | |
13 | lube | |
14 | | |
. This is the final result you get.. ( I took the liberty of including a header row, as this is often a good idea with VBA and Excel stuff )
Using Excel 2007
- | A | B | C | D | E | F | G |
1 | In | | | | | | Out |
2 | type1 | | | | | | type1 |
3 | apples | | | | | | apples |
4 | oranges | | | | | | oranges |
5 | pears | | | | | | pears |
6 | type2 | | | | | | type2 |
7 | apples | | | | | | apples |
8 | apples | | | | | | apples |
9 | apples | | | | | | apples |
10 | type1 | | | | | | |
11 | bear | | | | | | |
12 | type2 | | | | | | |
13 | lube | | | | | | |
Code:
Code:
[color=blue]Sub[/color] ReorgTogas()
[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("Toga") [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 the following 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]
[color=blue]If[/color] Left$(arrIn(runc, 1), 4) = "type" [color=blue]Then[/color] [color=lightgreen]'check for a type heading in list[/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]Else[/color] [color=lightgreen]'Redundant Code - assign no key to things in a type list[/color]
[color=blue]End[/color] [color=blue]If[/color]
[color=blue]Next[/color] runc
Dim Eunuchs() [color=blue]As[/color] Variant: [color=blue]Let[/color] Eunuchs() = 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]' [color=blue]Dim[/color] 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 ) Main Looping to make Array for output..[/color]
Dim rws [color=blue]As[/color] [color=blue]Long[/color], runcs [color=blue]As[/color] [color=blue]Long[/color], rout [color=blue]As[/color] Long: [color=blue]Let[/color] rout = 0 [color=lightgreen]' "Rows" of Input Array, rows within euniques list, and "rows" of output Array,[/color]
[color=blue]For[/color] runc = [color=blue]LBound[/color](Eunuchs()) [color=blue]To[/color] [color=blue]UBound[/color](Eunuchs()) [color=lightgreen]'take each unique List type[/color]
[color=blue]For[/color] rws = 2 [color=blue]To[/color] [color=blue]UBound[/color](arrIn(), 1) [color=lightgreen]'go down input "row"[/color]
[color=blue]If[/color] arrIn(rws, 1) = Eunuchs(runc) [color=blue]Then[/color]
[color=blue]Let[/color] rout = rout + 1 [color=lightgreen]'goto next empty space in Output Array and[/color]
[color=blue]Let[/color] arrOut(rout, 1) = arrIn(rws, 1)
[color=blue]For[/color] runcs = 1 [color=blue]To[/color] 234 [color=lightgreen]'234 is arbritrary number - change to maximim possible items in a unique List if you know it.[/color]
[color=blue]If[/color] [color=blue]Not[/color] dicLookupTable.Exists(arrIn((rws + runcs), 1)) [color=blue]Then[/color] [color=lightgreen]'If the next roow is not a unique list[/color]
[color=blue]Let[/color] rout = rout + 1 [color=lightgreen]'goto next empty space in Output Array and[/color]
[color=blue]Let[/color] arrOut(rout, 1) = arrIn(rws + runcs, 1)
[color=blue]Else[/color]
[color=blue]GoTo[/color] NextrEunich [color=lightgreen]'We have hit a List type heading so we stop adding to the rows of the output array...and..[/color]
[color=blue]End[/color] [color=blue]If[/color] [color=lightgreen]' ... go and...[/color]
[color=blue]Next[/color] runcs [color=lightgreen]' look for the next eunich List type[/color]
[color=blue]Else[/color] [color=lightgreen]'redundant code: have not found a List type yet[/color]
[color=blue]End[/color] [color=blue]If[/color]
[color=blue]Next[/color] rws
[color=blue]Next[/color]rEunich: [color=lightgreen]'"Sprung point" to come to once a Unique type with all contents has been put in Output Array[/color]
Next runc
[color=lightgreen]'4) Output to sheet[/color]
[color=blue]Let[/color] ws.Range("A1").Resize(1, 7).Value = Array("In", , " ", , , , "Out") [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 simplw = step[/color]
[color=blue]Let[/color] ws.Range("G2").Resize(UBound(arrOut(), 1), 1).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=blue]End[/color] [color=blue]Sub[/color] [color=lightgreen]'ReorgTogas()[/color]
. I fear you will be coming back with questions….( such as: “??? I have no idea how to run a macro” …;. or “I got my requirement wrong.”. ..;.. or “it would not work because my actual data is.”. etc, etc.. )
. Be patient.. I am automatically informed of your Posts here. But I just do this for fun in my spare time, like most of us here, and I may be “off” for a while…
. In the unlikely event that you do not have any questions and everything works perfectly as you want then it would be nice if you let me know ..
. Alan
( Of course I may well have not got the code 100% bullet proof, - that’s is not possible at this stage with limited data etc.. )