Conditional Concatanation of a range of cells /VBA/Macro

Spyros13

Board Regular
Joined
Mar 12, 2014
Messages
175
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
On first run of this code, the formula it created, ConcatanateIF worked. I MUST RE-ITERATE, THAT THIS CODE AND THE FUNCTION IT CREATED - ConcatenateIf(criteria_range, criteria, values_range, delimiter) WORKED ABSOLUTELY PERFECTLY FOR ME. I APPLIED IT ACCROSS MY RANGE OF CELLS, DID DROP DOWN APPLICATION, AND MAGIC.

BUT SINCE then it "degenerated", and turned all my cells into "#value".

Since then I havnt been able to get it to work.

Created by Jon von der Heyden - Look him up on google. He's really into it and helpfull in his free blog; http://jonvonderheyden.net/wp-login.php?redirect_to=http%3A%2F%2Fjonvonderheyden.net%2Fabout-jon-von-der-heyden%2F

Anyway, also since then, I havnt been able to run any other function macros.

First time it worked, without needing "to call" the function with a SUB. IT WORKED PERFECTLY JUST AS IT IS. Copy paste in new module, run it, and then go to sheet, and apply formula.

But now not only has the function in excel degenerated (i.e. not working) but also running the function as a macro, seems to not work.

Rich (BB code):
'By Jon von der Heyden
'http://jonvonderheyden.net/excel/concatenate-a-range-of-values/

OptionExplicit

PublicFunction ConcatenateIf(ByVal rngCriteriaRange As Excel.Range, _
ByVal varCriteria AsVariant, _
ByVal rngValues As Excel.Range, _
OptionalByVal strDelimiter AsString = " ") AsVariant
Dim lngRows AsLong, lngCols AsLong
Dim blnErr AsBoolean, lngErr As XlCVError
Dim strCritAddress AsString
Dim strValAddress AsString
Dim varOperators AsVariant: varOperators = VBA.Array("=", "<>", ">", "<", ">=", "<=")
Dim strOperator AsString
Dim varResults AsVariant

With rngCriteriaRange
        lngRows = .Rows.Count
        lngCols = .Columns.Count
EndWith

'#REF! if 2D criteria range is passed
   blnErr = CBool(lngRows > 1 And lngCols > 1)
If blnErr Then
        lngErr = xlErrRef
GoTo err_exit
EndIf

'#VALUE! if values range dimension is not the same size and orientation as criteria range
With rngValues
        blnErr = CBool(lngRows <> .Rows.Count)
        blnErr = CBool(blnErr Or lngCols <> .Columns.Count)
If blnErr Then
            lngErr = xlErrValue
GoTo err_exit
EndIf
EndWith

'#N/A if the criteria is an array (or more than one cell)
   blnErr = IsArray(varCriteria)
If blnErr Then
        lngErr = xlErrNA
GoTo err_exit
EndIf

'Split the operator from the criteria, if an operator has been included
   strOperator = Left$(varCriteria, 2)
If IsNumeric(Application.Match(strOperator, varOperators, 0)) Then
        varCriteria = Mid$(varCriteria, 3)
Else
        strOperator = Left$(varCriteria, 1)
If IsNumeric(Application.Match(strOperator, varOperators, 0)) Then
            varCriteria = Mid$(varCriteria, 2)
Else
            strOperator = "="
EndIf
EndIf

'Make sure the criteria type is correct, and concatenate the operator with the criteria
If IsDate(varCriteria) Then
        varCriteria = strOperator & CDbl(varCriteria)
Else
If IsNumeric(varCriteria) Then
            varCriteria = strOperator & varCriteria
Else
            varCriteria = strOperator & Chr$(34) & varCriteria & Chr$(34)
EndIf
EndIf

'Get the addresses of the criteria and values ranges
   strCritAddress = rngCriteriaRange.Address(external:=True)
    strValAddress = rngValues.Address(external:=True)

'Construct an array of the results
If lngRows > 1 Then
        varResults = Evaluate("transpose(if(" & strCritAddress & varCriteria & "," & strValAddress & "))")
Else
        varResults = Evaluate("if(" & strCritAddress & varCriteria & "," & strValAddress & ")")
EndIf

'Remove non-matching items from the array, and concatenate the remaining items
   varResults = Filter(varResults, False, False)
    ConcatenateIf = Join$(varResults, strDelimiter)

ExitFunction

err_exit:
    ConcatenateIf = CVErr(lngErr)
EndFunction 



There's another piece of code for doing excactly what I want, but since that is written as a Function aswell, does not run on my excel.

see: String Concatenation for that. Copying in here:

Rich (BB code):
Function StringConcat(Sep As String, ParamArray Args()) As Variant''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' StringConcat' By Chip Pearson, chip@cpearson.com, www.cpearson.com'                  www.cpearson.com/Excel/stringconcatenation.aspx' This function concatenates all the elements in the Args array,' delimited by the Sep character, into a single string. This function' can be used in an array formula. There is a VBA imposed limit that' a string in a passed in array (e.g.,  calling this function from' an array formula in a worksheet cell) must be less than 256 characters.' See the comments at STRING TOO LONG HANDLING for details.''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''Dim S As StringDim N As LongDim M As LongDim R As RangeDim NumDims As LongDim LB As LongDim IsArrayAlloc As Boolean'''''''''''''''''''''''''''''''''''''''''''' If no parameters were passed in, return' vbNullString.'''''''''''''''''''''''''''''''''''''''''''If UBound(Args) - LBound(Args) + 1 = 0 Then    StringConcat = vbNullString    Exit FunctionEnd IfFor N = LBound(Args) To UBound(Args)    ''''''''''''''''''''''''''''''''''''''''''''''''    ' Loop through the Args    ''''''''''''''''''''''''''''''''''''''''''''''''    If IsObject(Args(N)) = True Then        '''''''''''''''''''''''''''''''''''''        ' OBJECT        ' If we have an object, ensure it        ' it a Range. The Range object        ' is the only type of object we'll        ' work with. Anything else causes        ' a #VALUE error.        ''''''''''''''''''''''''''''''''''''        If TypeOf Args(N) Is Excel.Range Then            '''''''''''''''''''''''''''''''''''''''''            ' If it is a Range, loop through the            ' cells and create append the elements            ' to the string S.            '''''''''''''''''''''''''''''''''''''''''            For Each R In Args(N).Cells                If Len(R.Text) > 0 Then                    S = S & R.Text & Sep                End If            Next R        Else            '''''''''''''''''''''''''''''''''            ' Unsupported object type. Return            ' a #VALUE error.            '''''''''''''''''''''''''''''''''            StringConcat = CVErr(xlErrValue)            Exit Function        End If        ElseIf IsArray(Args(N)) = True Then        '''''''''''''''''''''''''''''''''''''        ' ARRAY        ' If Args(N) is an array, ensure it        ' is an allocated array.        '''''''''''''''''''''''''''''''''''''        IsArrayAlloc = (Not IsError(LBound(Args(N))) And _            (LBound(Args(N)) <= UBound(Args(N))))        If IsArrayAlloc = True Then            ''''''''''''''''''''''''''''''''''''            ' The array is allocated. Determine            ' the number of dimensions of the            ' array.            '''''''''''''''''''''''''''''''''''''            NumDims = 1            On Error Resume Next            Err.Clear            NumDims = 1            Do Until Err.Number <> 0                LB = LBound(Args(N), NumDims)                If Err.Number = 0 Then                    NumDims = NumDims + 1                Else                    NumDims = NumDims - 1                End If            Loop            On Error GoTo 0            Err.Clear            ''''''''''''''''''''''''''''''''''            ' The array must have either            ' one or two dimensions. Greater            ' that two caues a #VALUE error.            ''''''''''''''''''''''''''''''''''            If NumDims > 2 Then                StringConcat = CVErr(xlErrValue)                Exit Function            End If            If NumDims = 1 Then                For M = LBound(Args(N)) To UBound(Args(N))                    If Args(N)(M) <> vbNullString Then                        S = S & Args(N)(M) & Sep                    End If                Next M                            Else                ''''''''''''''''''''''''''''''''''''''''''''''''                ' STRING TOO LONG HANDLING                ' Here, the error handler must be set to either                '   On Error GoTo ContinueLoop                '   or                '   On Error GoTo ErrH                ' If you use ErrH, then any error, including                ' a string too long error, will cause the function                ' to return #VALUE and quit. If you use ContinueLoop,                ' the problematic value is ignored and not included                ' in the result, and the result is the concatenation                ' of all non-error values in the input. This code is                ' used in the case that an input string is longer than                ' 255 characters.                ''''''''''''''''''''''''''''''''''''''''''''''''                On Error GoTo ContinueLoop                'On Error GoTo ErrH                Err.Clear                For M = LBound(Args(N), 1) To UBound(Args(N), 1)                    If Args(N)(M, 1) <> vbNullString Then                        S = S & Args(N)(M, 1) & Sep                    End If                Next M                Err.Clear                M = LBound(Args(N), 2)                If Err.Number = 0 Then                    For M = LBound(Args(N), 2) To UBound(Args(N), 2)                        If Args(N)(M, 2) <> vbNullString Then                            S = S & Args(N)(M, 2) & Sep                        End If                    Next M                End If                On Error GoTo ErrH:            End If        Else            If Args(N) <> vbNullString Then                S = S & Args(N) & Sep            End If        End If        Else        On Error Resume Next        If Args(N) <> vbNullString Then            S = S & Args(N) & Sep        End If        On Error GoTo 0    End IfContinueLoop:Next N'''''''''''''''''''''''''''''' Remove the trailing Sep'''''''''''''''''''''''''''''If Len(Sep) > 0 Then    If Len(S) > 0 Then        S = Left(S, Len(S) - Len(Sep))    End IfEnd IfStringConcat = S'''''''''''''''''''''''''''''' Success. Get out.'''''''''''''''''''''''''''''Exit FunctionErrH:'''''''''''''''''''''''''''''' Error. Return #VALUE'''''''''''''''''''''''''''''StringConcat = CVErr(xlErrValue)End Function

3 questions.

1. Why did Jon Von Der Hayden's macro work first time round for me? (PERFECTLY!) without the need for "calling it" or any other thing (like some of my other function macros)

2. Why did it then degenerate (I think this is something to do with me creating/inserting another module in the same sheet, just after just having applied the formula and running it, and then running something else instead in a new module)

3. why does the stringconcat not run now either?



My try solution. Im going to close all excel, create a brand new sheet/wrkbook, and start from scratch and re-paste in the code in a nee module in THAT wrkdbook and see if that helps.

Alternatively, anyone who already know of this macro and has the "call (sub)" for it to run, I would appreciate to see it and try that instead as a new fucntion.
 
Last edited:

Excel Facts

Show numbers in thousands?
Use a custom number format of #,##0,K. Each comma after the final 0 will divide the displayed number by another thousand
this is way above my head but apply problem solving techniques - on a brand new worksheet gradually add code to do certain things and see where the malfunction occurs - all the time adding another module in the sheet that you know works....
 
Upvote 0

Forum statistics

Threads
1,214,827
Messages
6,121,824
Members
449,050
Latest member
Bradel

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top