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

[DocAElstein]

continued from last post.......

Private Sub Worksheet_Change(ByVal Target As Range)
This reacts to changes of values in column A, for example when selecting a value from the drop down list
Initially a "Blank" selection is changed to "" , and if a "-" was given then the original range is restored

The rest of this routine is very similar to the routine here https://www.eileenslounge.com/viewto...245286#p245218 The difference is that we need here now to determine one set of column indices to use in a code line like pseudo the following to get the required filtered range
Output() = Index ( Cells , allRowIndicies , someColumnIndicies)
( The previous example at that link required all columns and 2 sets of some rows for two outputs based on a column having a Y or not )

Sub testieCLDoWhile()
Dim testieletter As String
 Let testieletter = CLDoWhile(3) ' should return "C"
End Sub
'   CLDoWhile  is a Function to get column letter from column number
Function CLDoWhile(ByVal lclm As Long) As String 'Using chr function and Do while loop      For example http://www.excelforum.com/excel-programming-vba-macros/796472-how-to-go-from-column-number-to-column-letter.html
Dim rest As Long 'Variable for what is "left over" after subtracting as many full 26's as possible
    Do
    '    Let rest = ((lclm - 1) Mod 26) 'Gives 0 to 25 for Column Number "Left over" 1 to 26. Better than ( lclm Mod 26 ) which gives 1 to 25 for clm 1 to 25 then 0 for 26
    '    Let FukOutChrWithDoWhile = Chr(65 + rest) & FukOutChrWithDoWhile 'Convert rest to Chr Number, initially with full number so the "units" (0-25), then number of 26's left over (if the number was so big to give any amount of 26's in it, then number of 26's in the 26's left over (if the number was so big to give any amount of 26 x 26's in it, Enit ?
    '    'OR
    Let CLDoWhile = Chr(65 + (((lclm - 1) Mod 26))) & CLDoWhile
    Let lclm = (lclm - (1)) \ 26 'This gives the number of 26's ( if any ), but just the excact part, in the next number down , - so applying the rest formula to this new number will again leave a difference "left over" rest.
    'lclm = (lclm - (rest + 1)) \ 26 ' As the number is effectively truncated here, any number from 1 to (rest +1)  will do in the formula
    Loop While lclm > 0 'Only loop further if number was big enough to still have 0-25's in it
End Function
'
'
Sub testieWksChange()
 Call Worksheet_Change(Me.Range("A2"))
 Let Application.EnableEvents = True ' Just incase it got turned off
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    If IsArray(Target.Value) Then Exit Sub
Rem 1 main worksheet data range info
Dim CntItms As Long: Let CntItms = Me.Range("B" & Rows.Count & "").End(xlUp).Row
    If Application.Intersect(Target, Me.Range("A2:A" & CntItms & "")) Is Nothing Then Exit Sub ' only do anything for a selection in the A column range.
Dim CntClms As Long: Let CntClms = Me.Cells.Item(1, Columns.Count).End(xlToLeft).Column
    If Target.Value = "Blank" Then Let Application.EnableEvents = False: Let Target.Value = "": Let Application.EnableEvents = True
Rem 2 test data range reset
    If Target.Value = "-" Then
     Let Application.EnableEvents = False
     Let Me.Range("C1", Me.Cells.Item(CntItms, Worksheets("Sheet1 (2)").Cells.Item(1, Columns.Count).End(xlToLeft).Column)).Value = Worksheets("Sheet1 (2)").Range("C1", Worksheets("Sheet1 (2)").Cells.Item(CntItms, Worksheets("Sheet1 (2)").Cells.Item(1, Columns.Count).End(xlToLeft).Column)).Value
     Let Application.EnableEvents = True
Rem 3 Get indices( column numbers) for required columns, and all row indicies
    '3a) indices( column numbers) for required columns
    Else ' selected value is a unique value or ""  for  "Blank"
    Dim arrLine() As Variant: Let arrLine() = Me.Range(Me.Cells.Item(Target.Row, 1), Me.Cells.Item(Target.Row, CntClms)).Value ' I dont need the first and third column, but it makes it easier to keep track of the correct columns indicie
    Dim Cnt As Long
    Dim strClms As String: Let strClms = "1 2 " ' For our required columns containing in this row the target selected value
        For Cnt = 3 To CntClms ' check columns from 3 for a match to the value in column 1
            If CStr(arrLine(1, Cnt)) = CStr(Target.Value) Then ' This is indication of wanted column as it contains the value
             Let strClms = strClms & Cnt & " "
            Else
            End If
        Next Cnt
     Let strClms = Left(strClms, Len(strClms) - 1) ' Take off last " "
    Dim clmsSpt() As String: Let clmsSpt() = Split(strClms, " ", -1, vbBinaryCompare)
    Dim Clms() As String: ReDim Clms(1 To UBound(clmsSpt()) + 1) ' for        {1,2,7,9} = required columns
        For Cnt = 0 To UBound(clmsSpt())
         Let Clms(Cnt + 1) = clmsSpt(Cnt)
        Next Cnt
    '3b) all data ro indicies
    Dim Rws() As Variant: Let Rws() = Evaluate("=Row(1:" & CntItms & ")") ' = {1;2;3;4;5;6;7;8;9;.......... , CntItms} = required rows ( all rows are required )
Rem 4 Output filtered columns
     Dim arrOut() As Variant: Let arrOut() = Application.Index(Cells, Rws(), Clms())
     Let Application.EnableEvents = False
     Me.Cells.ClearContents
     Let Range("A1").Resize(UBound(arrOut(), 1), UBound(arrOut(), 2)).Value = arrOut()
     Let Application.EnableEvents = True
    End If
End Sub


Sub testsort()

Dim df As String, d As String
 df = "df"
 Dim var
  If IsNumeric(df) Then var = CLng(df)
 Dim dg As String
 dg = "dg"
 MsgBox (dg > df) & "   " & (dg > d)
 

End Sub