In support of answer to this excelfox Thread:
http://www.excelfox.com/forum/showth...ll=1#post11090
Code:Option Explicit Sub DefaultItem() Rem 1 data range info Dim rngIn As Range, Lr As Long, ClmCnt As Long Let ClmCnt = 3 ' : Let ClmCnt = Worksheets("Sheet2").Range("A1").CurrentRegion.Columns.Count Let Lr = Worksheets("Sheet2").Range("A1").CurrentRegion.Rows.Count Set rngIn = Worksheets("Sheet2").Range("A1:C" & Lr & "") Rem 2 Data to array Dim arrDtaIn() As Variant ' I need Variant type as the .Value in the next line returns a field of Variant type elements Let arrDtaIn() = rngIn.Value Rem 3 Determine default values ' 3a) Number of groups Dim arrGp() As Variant: Let arrGp() = Application.Index(rngIn, 0, 1).Value ' http://www.excelfox.com/forum/showthread.php/1111-VBA-Trick-of-the-Week-Slicing-an-Array-Without-Loop-%E2%80%93-Application-Index Highlight arrGp and Hit F9.JPG : https://imgur.com/PZF0oXE Dim strGps As String: Let strGps = " " ' For a string like " 1 2 3 " Dim cnt As Long For cnt = 2 To Lr ' looking at all rows from the second in our input data If InStr(1, strGps, " " & arrGp(cnt, 1) & " ") = 0 Then ' This looks for the positiopn along ( starting from character 1 , in strGps , of each row element arrGp(cnt, 1) ) if it is not found then Instr retourns 0 as a n indication that it was not there Let strGps = strGps & arrGp(cnt, 1) & " " ' Because it is not there, we now put it in Else End If Next cnt ' At this point we should have like strGps = " 1 2 3 " ' 3b) Array of unique groups Let strGps = Trim(strGps) ' This takes off the first and last trailing spaces Dim arrGps() As String ' The string split function below returns a fiels of String elements : Highlight arrGps Hit F9.JPG : https://imgur.com/LT9dgHk Let arrGps() = Split(strGps, " ", -1, vbBinaryCompare) ' this splits the ( strgps , using " " as denominator , and returns all elemants in an array, using exact binary computer match on the " " ) ' 3c) Array for output Dim arrOut() As String ' A dynamic array is needed as I can only use variables in the ReDim method - I cannot use varable in the declaration (Dim) statement ReDim arrOut(1 To UBound(arrGps()) + 2, 1 To 2) ' I want +1 rows for the header I also need +1 because split retouns a 1 dimensional array stating at indicie 0 - so the Ubound of arrGps() will give a numbe 1 less than I might expect - in our example we have 3 elements with indicies of 0 1 2, ( and values in our example of 1 2 3 - for example arrGps(0)=1 ) so the Ubound returns 2 - but we want 3 elements ' 3d) fill my arrOut() Dim Stear As Variant ' I want to use a For ´Each loop below VBA must have an object varaible or a variable of variant type to hold each item in a collection of something. Our arrGps() can be considered a collection of numbers 1 2 3 Dim ArrOutRw As Long: Let ArrOutRw = 1 ' Our row number in the outout array : I use 1 initially, for the header Let arrOut(ArrOutRw, 1) = arrDtaIn(1, 1): Let arrOut(ArrOutRw, 2) = "Deafault item" For Each Stear In arrGps() ' This outer loop goes throug each unique group number =============== - For each number in { 1, 2, 3 } For cnt = 2 To Lr ' An Inner loop to go through all data rows ' ----------------------------- If CStr(arrDtaIn(cnt, 1)) = CStr(Stear) Then ' This will catch the first use of our group number, Stear is our group number taken from the array 1 2 3 Let ArrOutRw = ArrOutRw + 1 ' Our next row to fill in arrOut() Let arrOut(ArrOutRw, 1) = Stear ' First column in our output array Let arrOut(ArrOutRw, 2) = arrDtaIn(cnt, 2) ' Second column in our output array will be given the first item in column B of our data for this group number, Stear Exit For ' I only want to get the first item for a group number Else End If Next cnt ' ---------------------------------------------------------------------------------- Next Stear ' ==================================================================================== ' at this point we have an array for output of default : Select ArrOut then Hit F9.JPG : https://imgur.com/CNMeYV9 Rem 4 Demo Output Let rngIn.Offset(0, ClmCnt).Resize(UBound(arrOut(), 1), 2).Value = arrOut() ' In the range which offset to the right of the input, of the dimension size of the output array, I paste my values out End Sub




Reply With Quote
Bookmarks