[color=blue]Option[/color] [color=blue]Explicit[/color]
[color=blue]Sub[/color] SOLTECVBACode1()
[color=lightgreen]'VBA Array Method[/color]
[color=blue]Dim[/color] wsOrg [color=blue]As[/color] Worksheet: [color=blue]Set[/color] wsOrg = ThisWorkbook.Worksheets("VBACode") [color=lightgreen]'[/color]
[color=blue]Dim[/color] rws [color=blue]As[/color] [color=blue]Long[/color], r [color=blue]As[/color] Long 'variables for "rows" or "horizontal" count to be used in various loopings for row or first co ordinate in arrays'( Long is a Big whole Number limit (-2,147,483,648 to 2,147,483,647) -Most smaller numbers, Byte, Integer, Single are converted in computer to long so no advantage of Dim to smaller Type here)
[color=blue]Dim[/color] lr [color=blue]As[/color] Long: [color=blue]Let[/color] lr = wsOrg.Cells.Find(What:="*", after:=wsOrg.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), sercching for anything ( = * ) by rows, then get the row number. This allows for different excel versions with different available Row numbers) Just a different method here for fun- finds last row in sheet rather than row for last entry in particular cell[/color]
[color=lightgreen]'"Capture" Spreadsheet Data to Array[/color]
[color=blue]Dim[/color] arrOrg() [color=blue]As[/color] Variant: [color=blue]Let[/color] arrOrg() = wsOrg.Range("A1").CurrentRegion.Value [color=lightgreen]'One of many methods to capture[/color]
[color=lightgreen]'make an Array for Unique Search values, using a Tempory column[/color]
[color=blue]Dim[/color] lshtc [color=blue]As[/color] Long: [color=blue]Let[/color] lshtc = wsOrg.Columns.Count [color=lightgreen]'Number of Columns in sheet (May be differtent for different Excel versions[/color]
[color=lightgreen]'Let lshtc = 5 'For debugging to see the array bring it in "view"[/color]
[color=blue]Let[/color] wsOrg.Cells(1, lshtc) = "Unique" [color=lightgreen]'The last Column inn the sheet is used. (This has an advantage of not interfering with our Method for getting lc). hee just for fun we give the array, that is to say the tempory column, a heading[/color]
[color=blue]For[/color] rws = 2 [color=blue]To[/color] lr [color=blue]Step[/color] 1 [color=lightgreen]'Going down all rows from just after heading[/color]
[color=blue]On[/color] [color=blue]Error[/color] [color=blue]Resume[/color] [color=blue]Next[/color] [color=lightgreen]'This error handler is for the predicted error if no match, so below line errors in which case we go on at the line just after the next[/color]
[color=blue]If[/color] wsOrg.Cells(rws, 1) <> "" And Application.WorksheetFunction.Match(wsOrg.Cells(rws, 1), wsOrg.Columns(lshtc), 0) = -1234 [color=blue]Then[/color] [color=lightgreen]'provided something is there, we check to see if that value is already in our vLook Up Array by looking to see for a match. If it is not there then, the predicted error occurs.......[/color]
wsOrg.Cells(wsOrg.Rows.Count, lshtc).End(xlUp).Offset(1).Value = wsOrg.Cells(rws, 1).Value [color=lightgreen]'.....so we come here and put value in our tempory column for the unique values[/color]
[color=blue]Else[/color] [color=lightgreen]'Else do nothing, we come here if no error, but match number was not -1234 - so .Match gave some co ordinate indicating value was alrerady there[/color]
[color=blue]End[/color] [color=blue]If[/color]
[color=blue]Next[/color] rws
[color=blue]Dim[/color] arrUniques() [color=blue]As[/color] Variant: [color=blue]Let[/color] arrUniques() = wsOrg.Range(wsOrg.Cells(2, lshtc), wsOrg.Cells(wsOrg.Cells(wsOrg.Rows.Count, lshtc).End(xlUp).Row, lshtc)).Value [color=lightgreen]'Array for unique values returned from assignong dynamic array to the last column tempory range[/color]
wsOrg.Columns(lshtc).Delete [color=lightgreen]'Delete the tempory Column (Delete is usually better than Clear.. >> http://www.mrexcel.com/forum/excel-questions/787428-clear-delete-shift-%3Dxlup-let-y-%3D-y-%96-1-usedrange-rows-count-anomale.html[/color]
[color=lightgreen]'End of making an Array----------------------------------------[/color]
[color=lightgreen]'[/color]
'Loopin within array to produce required output array
[color=blue]Dim[/color] strTemp [color=blue]As[/color] [color=blue]String[/color] [color=lightgreen]'Temporary string to be used for concatenated output[/color]
Dim arrOut() [color=blue]As[/color] String: [color=blue]ReDim[/color] arrOut(1 [color=blue]To[/color] [color=blue]UBound[/color](arrUniques(), 1), 1 [color=blue]To[/color] 1) [color=lightgreen]'For consistence Set a 1 column 2 dimension array identical in size to the unique array. (ReDim must be used as Dim only takes actual numbers, not variables[/color]
[color=blue]For[/color] rws = 1 [color=blue]To[/color] 1 [color=lightgreen]'UBound(arrOut(), 1) 'For each unique value[/color]
[color=blue]For[/color] r = 1 [color=blue]To[/color] [color=blue]UBound[/color](arrOrg(), 1)
[color=blue]If[/color] arrOrg(r, 1) = Left(arrOrg(r, 2), 5) [color=blue]Then[/color] [color=lightgreen]'match conditions met[/color]
[color=blue]Let[/color] strTemp = strTemp & " ; " & arrOrg(r, 2)
[color=blue]Else[/color]
[color=blue]End[/color] [color=blue]If[/color]
[color=blue]Next[/color] r
[color=blue]If[/color] strTemp <> "" [color=blue]Then[/color]
strTemp = VBA.Mid(strTemp, 4, Len(strTemp) - 3) [color=lightgreen]'Chop of first " ; "[/color]
[color=blue]Let[/color] arrOut(rws, 1) = strTemp [color=lightgreen]'Output for this row[/color]
[color=blue]Else[/color] [color=lightgreen]'No match conditions fpound, no concatenated string to put in outout array[/color]
[color=blue]End[/color] [color=blue]If[/color]
[color=blue]Next[/color] rws
[color=blue]Let[/color] wsOrg.Range("C2").Resize(UBound(arrOut(), 1), 1).Value = arrOut()
[color=blue]End[/color] [color=blue]Sub[/color]
> </o
