Translate


Featured post

Working with two monitors

Working with two monitors is realy great. There are keyboard shortcuts in Windows 7 that make the work with them much easier and faster ...

2014-12-04

Array formula (CSE) in a VBA code

Sometimes for continuing of a code we need to get a value from a range in the sheet. For example we have a range with numbers and we want to find a minimum. There is the object called WorksheetFunction, then we can write:
Select all
var = Application.WorksheetFunction.Min(Range("A2:A10"))
It's very simple, isn't it? Which methods (worksheet functions) we can use by this way you can read here.

But if we need a minimum for the same range, but value in column B must be specific, at this moment a lot of poeple make loops. But why? In the sheet we can enter this formula (CTRL+SHIFT+ENTER):

{=MIN(IF(B2:B10="a",A2:A10,MAX(A2:A10)))}

and the result we have in a single step. Can we use it in our code? Answer is yes, we can. There is a method Evaluate which transforms a text to value. In the code we can write:

Select all
var = Evaluate("=MIN(IF(B2:B10=""a"",A2:A10,MAX(A2:A10)))")
and we get the result in a single step.

Combination with VBA function

Using the worksheet functions is always better then a VBA code. It's the best way how to pick up Excel. However, there are some cases, in which we have to use a used defined function (UDF). For example, sometimes people ask: "I have a data in the range and I need insert them to one cell. How can I do it?".

We could use either loops or Evaluate for this. If we know this function returns values, we are able to write:
Select all
var = Evaluate("TRANSPOSE(" & rRange.Address & ")")
Now the variable var contents an array of the cells values. We use Join function to get the value in a single step.
Select all
Function CONCATENATE_RANGE(rRange As Range, Optional sDelimiter As String = ",") As String
  CONCATENATE_RANGE = Join(Evaluate("TRANSPOSE(" & rRange.Address & ")"), sDelimiter)
End Function
If there are some empty cells in the range, still we don't need a loop. We can use Filter function.
Select all
Function CONCATENATE_RANGE(rRange As Range, Optional sDelimiter As String = ",") As String
  CONCATENATE_RANGE = Replace(Join(Filter(Evaluate("TRANSPOSE(IF(ISBLANK(" & rRange.Address & "),"""",""###"")&" & rRange.Address & ")"), "###"), ","), "###", vbNullString)
End Function

Let's go on

Complication: we need only values from column A if in column B is a specific value. CSE formula can look

{=IF(B2:B10="a",A2:A10,"")}

but the result contains zero lenght strings instead of values which don't comply the condition. To get rid of them, we use the space character as a delimiter and we clean the result with Trim worksheet function.
Select all
var = Application.WorksheetFunction.Trim(Join(Evaluate("TRANSPOSE(IF(B2:B10=""a"",A2:A10,""""))"), " "))
We get the required values to one cell and still in a single step.

And finally

I adapted function CONCATENATE_RANGE to CONCATENATE_RANGEIF
Select all
Function CONCATENATE_RANGEIF(ByVal rRange As Range, ByVal vCrit As Variant, Optional ByVal rCon_Range As Range = Nothing, Optional ByVal sDelimiter As String = ",") As String
'rRange - Required. The range of cells that you want evaluated by criteria.
'vCrit - Required. Defines which cells will be added.
'rCon_Range - Optional. The actual cells to add, if you want to add cells other than those specified in the rRange argument.
'  If the rCon_Range argument is omitted, Excel adds the cells that are specified in the rRange argument.
'sDelimiter - Optional. Any string, used to separate the substrings in the returned string. If omitted, the comma (",") is used.
  
  Const sNonsence As String = "°°"
  
  If rCon_Range Is Nothing Then
    Set rCon_Range = rRange
  End If
  
  Select Case TypeName(vCrit)
    Case "String"
      vCrit = """" & vCrit & """"
    Case "Range"
      If TypeName(vCrit.Value) = "String" Then
        vCrit = """" & vCrit.Value & """"
      End If
  End Select
  
  Dim sResult As String
  sResult = Join(Evaluate("TRANSPOSE(IF(" & rRange.Address & "= " & vCrit & "," & rCon_Range.Address & ",""" & sNonsence & """))"), sDelimiter)
  sResult = Replace(sResult, sDelimiter & sNonsence, vbullstring)
  sResult = Replace(sResult, sNonsence & sDelimiter, vbullstring)
  
  Set rRange = Nothing
  Set rCon_Range = Nothing
  
  CONCATENATE_RANGEIF = sResult
End Function

No comments:

Post a Comment