Appendix Thread 2. ( Codes for other Threads, HTML Tables, etc.)

**DocAElstein** · 04-02-2019, 03:19 PM

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