-3

I am currently working on a UDF which returns and concatenates the headers if it is greater than and less than to a specific value. I’m not really good in Excel-Vba and what I got so far is this pathetic code which I couldn’t understand anymore. I would truly appreciate it if someone could help. Here's what i got so far:

Public Function greaterLessValue(Rng As Range, Rng2 As Range, greater, less)

Dim rngArr() As Variant
rngArr = Rng.value

For i = 1 To UBound(rngArr, 1)
    For j = 1 To UBound(rngArr, 2)
        If rngArr(i, j) = xVal Then
            For k = 1 To UBound(rngArr, 2)
                If rngArr(i, k) = Yval Then countRowAsso = countRowAsso + 1
            Next k
        End If
    Next j
Next i

End Function

If the value is greater than or equal to 5 and less than and equal to 10 it should return the same example bellow which concatenates the Header containing the specific value in the same column:

Community
  • 1
  • 1
Rakushoe
  • 118
  • 11
  • 4
    This code has *absolutely nothing* to do with your objective. :o – A.S.H Jan 29 '17 at 22:51
  • 1
    yeah sorry about that but you nailed it though... – Rakushoe Jan 29 '17 at 23:52
  • Well you have now three excellent and different solutions, that's a record :) – A.S.H Jan 29 '17 at 23:54
  • 1
    Given that the only difference between the code you posted and some code written by @ScottCraner is the function name `MyCount` being changed to `greaterLessValue` (and then incorrectly referred to as `countRowAsso` in the code), I think it is extremely rude to describe the code as "pathetic". – YowE3K Jan 30 '17 at 02:04

3 Answers3

2

Try this UDF:

Public Function greaterLess(values As Range, header As Range, a, b) As String
    Dim cel As Range
    For Each cel In values
        If cel.value >= a And cel.value <= b Then greaterLess  = _ 
          greaterLess & header.Cells(1, cel.Column - values.Column + 1) & ", "
    Next
End Function

Usage

Enter the following formula in Cell N2 :

=greaterLess(B2:M2, B$1:M$1, 5, 10)

Then copy N2, select N3:N7 and paste.

A.S.H
  • 29,101
  • 5
  • 23
  • 50
2

If you have Office 365 Excel you can do this with an array formula:

=TEXTJOIN(", ",TRUE,IF((B2:M2>=5)*(B2:M2<=10),B$1:M$1,""))

Being an array formula it needs to be entered with Ctrl-Shift-Enter instead of enter when exiting edit mode. IF done correctly then Excel will put {} around the formula.


If you do not have Office 365 Excel then you can use this UDF that will mimic the function.

Function TEXTJOIN(delim As String, skipblank As Boolean, arr)
    Dim d As Long
    Dim c As Long
    Dim arr2()
    Dim t As Long, y As Long
    t = -1
    y = -1
    If TypeName(arr) = "Range" Then
        arr2 = arr.Value
    Else
        arr2 = arr
    End If
    On Error Resume Next
    t = UBound(arr2, 2)
    y = UBound(arr2, 1)
    On Error GoTo 0

    If t >= 0 And y >= 0 Then
        For c = LBound(arr2, 1) To UBound(arr2, 1)
            For d = LBound(arr2, 1) To UBound(arr2, 2)
                If arr2(c, d) <> "" Or Not skipblank Then
                    TEXTJOIN = TEXTJOIN & arr2(c, d) & delim
                End If
            Next d
        Next c
    Else
        For c = LBound(arr2) To UBound(arr2)
            If arr2(c) <> "" Or Not skipblank Then
                TEXTJOIN = TEXTJOIN & arr2(c) & delim
            End If
        Next c
    End If
    TEXTJOIN = Left(TEXTJOIN, Len(TEXTJOIN) - Len(delim))
End Function

The formula is the same and still entered with Ctrl-Shift-Enter instead of Enter.

Scott Craner
  • 148,073
  • 10
  • 49
  • 81
2

A.S.H makes a good point on confirming that the ranges hold the same number of elements/values/cells. I've used a different approach.

Option Explicit

Public Function greaterLessValue(rng1 As Range, rng2 As Range, _
                                 greater As Double, lesser As Double)

    Dim i As Long, j As Long
    Dim rngArr1 As Variant, rngArr2 As Variant

    rngArr1 = rng1.Value2
    rngArr2 = rng2.Value2
    greaterLessValue = ""

    'use for showing array extents
    'delete or comment out when function works
    Debug.Print LBound(rngArr1, 1) & " to " & UBound(rngArr1, 1)
    Debug.Print LBound(rngArr1, 2) & " to " & UBound(rngArr1, 2)

    'used to ensure that the ranges hold the same number of columns
    'only affects the 2nd rank when used with Preserve
    ReDim Preserve rngArr2(LBound(rngArr1, 1) To UBound(rngArr1, 1), _
                            LBound(rngArr1, 2) To UBound(rngArr1, 2))

    For i = LBound(rngArr1, 1) To UBound(rngArr1, 1)
        For j = LBound(rngArr1, 2) To UBound(rngArr1, 2)
            If IsNumeric(rngArr2(i, j)) Then
                If rngArr2(i, j) >= greater And rngArr2(i, j) <= lesser Then
                    greaterLessValue = greaterLessValue & _
                                       IIf(CBool(Len(greaterLessValue)), ", ", vbNullString) & _
                                       rngArr1(i, j)
                End If
            End If
        Next j
    Next i

End Function

Syntax as per the following image:

enter image description here

Community
  • 1
  • 1