Scribd
Upload
3 views4 pages

Excel Arrays

The document outlines a VBA function for handling Excel arrays, specifically for filling and processing two input arrays based on specified criteria. It includes logic for determining the dimensions of the arrays, initializing an output array, and looping through the elements to evaluate conditions. The function ultimately joins the output based on a specified delimiter and returns the result.

Uploaded by

henex31312
Copyright
© © All Rights Reserved
We take content rights seriously. If you suspect this is your content, claim it here.
Available Formats
Download as PDF, TXT or read online on Scribd
3 views4 pages

Excel Arrays

The document outlines a VBA function for handling Excel arrays, specifically for filling and processing two input arrays based on specified criteria. It includes logic for determining the dimensions of the arrays, initializing an output array, and looping through the elements to evaluate conditions. The function ultimately joins the output based on a specified delimiter and returns the result.

Uploaded by

henex31312
Copyright
© © All Rights Reserved
We take content rights seriously. If you suspect this is your content, claim it here.
Available Formats
Download as PDF, TXT or read online on Scribd

Excel Arrays

'DIMENSIONS

'Filling the arrays

If IfRange.Cells.Count > 1 Then

IfArr = IfRange.Value

IfArrDim = Dimensions(IfArr)

Else

ReDim IfArr(1 To 1)

IfArr(1) = IfRange.Value

IfArrDim = 1

End If

If JoinRange.Cells.Count > 1 Then

JoinArr = JoinRange.Value

JoinArrDim = Dimensions(JoinArr)

Else

ReDim JoinArr(1 To 1)

JoinArr(1) = JoinRange.Value

JoinArrDim = 1

End If

'Ini alize the Output array to the smaller of the two input arrays.

ReDim OutputArr(IIf(IfRange.Cells.Count < JoinRange.Cells.Count, IfRange.Cells.Count - 1,


JoinRange.Cells.Count - 1))

'DEFINING THE LOOP PARAMETERS

'Loop ends on the smaller of the two arrays


If UBound(IfArr) > UBound(JoinArr) Then

LoopEnd(1) = UBound(JoinArr)

Else

LoopEnd(1) = UBound(IfArr)

End If

If IfArrDim = 2 Or JoinArrDim = 2 Then

If Not (IfArrDim = 2 And JoinArrDim = 2) Then

'mismatched dimensions

LoopEnd(2) = 1

ElseIf UBound(IfArr, 2) > UBound(JoinArr, 2) Then

LoopEnd(2) = UBound(JoinArr, 2)

Else

LoopEnd(2) = UBound(IfArr, 2)

End If

End If

'START LOOP

If IfArrDim = 1 Then

For i = 1 To LoopEnd(1)

If IsNumeric(IfArr(i)) And IfArr(i) <> "" Then

Expression = IfArr(i) & Criteria

Else

'Add quota on marks to allow string comparisons

Expression = """" & IfArr(i) & """" & Criteria

End If
MeetsCriteria = Applica on.Evaluate(Expression)

If MeetsCriteria Then

If JoinArrDim = 1 Then

OutputArr(JCount) = CStr(JoinArr(i))

Else

OutputArr(JCount) = CStr(JoinArr(i, 1))

End If

JCount = JCount + 1

End If

Next i

Else

For i = 1 To LoopEnd(1)

For j = 1 To LoopEnd(2)

If IsNumeric(IfArr(i, j)) And IfArr(i, j) <> "" Then

Expression = IfArr(i, j) & Criteria

Else

'Add quota on marks to allow string comparisons

Expression = """" & IfArr(i, j) & """" & Criteria

End If

MeetsCriteria = Applica on.Evaluate(Expression)

If MeetsCriteria Then

If JoinArrDim = 1 Then

OutputArr(JCount) = CStr(JoinArr(i))
Else

OutputArr(JCount) = CStr(JoinArr(i, j))

End If

JCount = JCount + 1

End If

Next j

Next i

End If

'END LOOP

ReDim Preserve OutputArr(JCount + 1 * (JCount > 0))

JOINIF = Join(OutputArr, Delimeter)

End Func on

Private Func on Dimensions(var As Variant) As Long

'Credit goes to the great Chip Pearson, [email protected], www.cpearson.com

On Error GoTo Err

Dim i As Long, tmp As Long

While True

i=i+1

tmp = UBound(var, i)

Wend

Err:

Dimensions = i - 1

End Func on

You might also like