Hi All,
i have moved on wordpress from blogspot, you can follow the same on
www.excelpoweruser.wordpress.com
Thanks
Rajan
i have moved on wordpress from blogspot, you can follow the same on
www.excelpoweruser.wordpress.com
Thanks
Rajan
Thursday, October 11, 2012
Wednesday, July 11, 2012
Filter Array : Revised
Here is an faster and easier way to filter 2D
Array
Syntex to Use :
FilterArray InputArray, ResultArray,
FilterColumn, FilterValue, FilterType
==============================================================================
Enum Combination
xlRow
xlColumn
End Enum
Enum FltType
xlFilterEqualTo
xlFilterLessThen
xlFilterLessThenEqualTo
xlFilterGreaterThen
xlFilterGreaterThenEqualTo
xlFilterDoesNotEqualTo
xlFilterContains
xlFilterDoesNotContain
End Enum
==============================================================================
Function FilterArray(InputArray As Variant,
ResultArray As Variant, FilterColumn As Long, FilterValue As Variant,
FilterType As FltType) As Boolean
' Created by Rajan 11-July-2012
' How
to Use :
'
Parameter Info
'
InputArray : 2D Array which need to be FIlter
'
ResultArray : in which Filterd Data will be stored
'
FilterCOlumn : On Which column you want to apply Filter
'
Filter Type : Select a Condition
'
Syntex :
'
FilterArray InputArray,ResultArray,FilterColumn,"Product1",xlFilterContains
'
'if
you want to apply Filter on Row , just Transpose the InputArray and Pass in
this Function :)
'
Dim
blnFlag As Boolean
Dim blnMatch
As Boolean
Dim
lngCount As Long
Dim
lngCount2 As Long
Dim
lngCount3 As Long
Dim
VarTempResult
Dim
VarTEmp
lngCount2 = 1
If
IsArray(InputArray) Then
If
UBound(InputArray) <= 0 Then
blnFlag = True
GoTo ExitEarly:
End If
Else
blnFlag = True
GoTo ExitEarly:
End If
If
FilterValue = "" Then
blnFlag = True
GoTo ExitEarly:
End If
ReDim
VarTEmp(UBound(InputArray))
For
lngCount = LBound(InputArray) To UBound(InputArray)
Select Case FilterType
Case xlFilterContains
If InStr(InputArray(lngCount, FilterColumn), FilterValue) Then blnMatch
= True
Case xlFilterDoesNotContain
If InStr(InputArray(lngCount, FilterColumn), FilterValue) = 0 Then
blnMatch = True
Case xlFilterDoesNotEqualTo
If InputArray(lngCount, FilterColumn) <> FilterValue Then blnMatch
= True
Case xlFilterEqualTo
If InputArray(lngCount, FilterColumn) = FilterValue Then blnMatch = True
Case xlFilterGreaterThen
If InputArray(lngCount, FilterColumn) > FilterValue Then blnMatch =
True
Case xlFilterGreaterThenEqualTo
If InputArray(lngCount, FilterColumn) >= FilterValue Then blnMatch =
True
Case xlFilterLessThen
If InputArray(lngCount, FilterColumn) < FilterValue Then blnMatch =
True
Case xlFilterLessThenEqualTo
If InputArray(lngCount, FilterColumn) <= FilterValue Then blnMatch =
True
End Select
If
blnMatch Then
VarTEmp(lngCount2) = lngCount
lngCount2 = lngCount2 + 1
blnMatch = False
End If
Next
lngCount2 = lngCount2 - 1
ReDim
VarTempResult(1 To lngCount2, 1 To UBound(InputArray, 2))
For lngCount = 1 To lngCount2
For lngCount3 = 1 To UBound(InputArray, 2)
VarTempResult(lngCount,
lngCount3) = InputArray(VarTEmp(lngCount), lngCount3)
Next lngCount3
Next lngCount
ResultArray = VarTempResult
FilterArray=True
ExitEarly:
If blnFlag Then
FilterArray = False
ResultArray = Null
End If
End Function
================================================================================
Thanks For reading
Tuesday, July 10, 2012
Filter 2D Array [Rows and Columns]
Hi,
Here is a
function to filter 2D Array either by Rows and Columns.
Syntex:
FilterArray InputArray , ResultArray , 1 , "Product1",xlFilterDoesNotEqualTo
Suppose you have An Array of Sales Data of Multiple Product , but you need to retrieve data only for one product in another array, Use this :)
================================================================================
Enum Combination
xlRow
xlColumn
End Enum
Enum FltType
xlFilterEqualTo
xlFilterLessThen
xlFilterLessThenEqualTo
xlFilterGreaterThen
xlFilterGreaterThenEqualTo
xlFilterDoesNotEqualTo
xlFilterContains
xlFilterDoesNotContain
End Enum
=================================================================================
Function FilterArray(InputArray As Variant, ResultArray As Variant,
FilterColumn As Long, FilterValue As Variant, FilterType As FltType) As Boolean
Dim blnFlag As Boolean
Dim blnMatch As Boolean
Dim lngCount As Long
If IsArray(InputArray) Then
If UBound(InputArray)
<= 0 Then
blnFlag = True
GoTo ExitEarly:
End If
Else
blnFlag = True
GoTo ExitEarly:
End If
If FilterValue =
"" Then
blnFlag = True
GoTo ExitEarly:
End If
For lngCount =
LBound(InputArray) To UBound(InputArray)
Select Case
FilterType
Case
xlFilterContains
If
InStr(InputArray(lngCount, FilterColumn), FilterValue) Then blnMatch = True
Case
xlFilterDoesNotContain
If
InStr(InputArray(lngCount, FilterColumn), FilterValue) = 0 Then blnMatch = True
Case xlFilterDoesNotEqualTo
If
InputArray(lngCount, FilterColumn) <> FilterValue Then blnMatch = True
Case
xlFilterEqualTo
If
InputArray(lngCount, FilterColumn) = FilterValue Then blnMatch = True
Case xlFilterGreaterThen
If
InputArray(lngCount, FilterColumn) > FilterValue Then blnMatch = True
Case
xlFilterGreaterThenEqualTo
If
InputArray(lngCount, FilterColumn) >= FilterValue Then blnMatch = True
Case xlFilterLessThen
If
InputArray(lngCount, FilterColumn) < FilterValue Then blnMatch = True
Case
xlFilterLessThenEqualTo
If
InputArray(lngCount, FilterColumn) <= FilterValue Then blnMatch = True
End Select
Dim ArrTemp
Dim ArrTemp2
If blnMatch Then
If Not
IsArray(ResultArray) Then
ResultArray =
Application.Index(InputArray, lngCount)
ResultArray =
Application.Transpose(ResultArray)
ConvertArrayOneD2TwoD ResultArray, ResultArray
blnMatch =
False
Else
ArrTemp =
Application.Index(InputArray, lngCount)
ConvertArrayOneD2TwoD ArrTemp, ArrTemp2
CombineArrayElements ResultArray, ArrTemp2, ResultArray, xlRow
blnMatch =
False
End If
End If
Next
ExitEarly:
If blnFlag Then
FilterArray = False
ResultArray = Null
End If
End Function
================================================================================
Private Function CombineArrayElements(ArrFirst As Variant, ArrAdd
As Variant, ArrResult As Variant, CombinationOf As Combination) As Boolean
'Created By Rajan
4-July-2012
'---------How to
Use-------------------
'Syntex
'CombineArrayCol
FirstArray ,SecondArray ,ResultArray
' FirstArray = FirstArray is in which second
array need to be combine,Must have atleast on column and Multidimensional
' SecondArray = SecondArray is which need to
combined with FirstArray,Must have atleast on column and Multidimensional
' ResultArray = ResultArray is in which
combined array will be stored
' CombinationOf = what you want to Combine
either Rows or Columns of Two Arrays
' This Function
Return True if Operation is succesfull and False with NULL Result array if
Operation is Not succeed
Dim blnFlag As
Boolean
Dim lngRow As Long
Dim lngCol As Long
Dim lngRow2 As Long
Dim lngCol3 As Long
Dim VarTemp
On Error Resume Next
'Validating Array ,
IsArray
If CombinationOf =
xlColumn Then
If IsArray(ArrFirst)
And IsArray(ArrAdd) Then ' if Both
Parameter is an Array
'Both array must
contain same Row Number
If
UBound(ArrFirst) = UBound(ArrAdd) Then
' Both Array must contain atleast
One Column
If
UBound(ArrAdd, 2) < 0 Or UBound(ArrFirst, 2) < 0 Then
If
UBound(ArrFirst) <> UBound(ArrAdd) Then
blnFlag = True
GoTo ExitEarly:
End
If
Else
blnFlag =
True
GoTo
ExitEarly:
End If
Else
blnFlag =
True
GoTo
ExitEarly:
End If
Else
blnFlag = True
GoTo ExitEarly:
End If
Else
If IsArray(ArrFirst)
And IsArray(ArrAdd) Then ' if Both Parameter
is an Array
'Both array must
contain same Columns Number
If
UBound(ArrFirst, 2) = UBound(ArrAdd, 2) Then
' Both Array
must contain atleast One Row
If
UBound(ArrAdd) > 0 Or UBound(ArrFirst) > 0 Then
If
UBound(ArrFirst, 2) <> UBound(ArrAdd, 2) Then
blnFlag = True
GoTo
ExitEarly:
End If
Else
blnFlag =
True
GoTo
ExitEarly:
End If
Else
blnFlag =
True
GoTo
ExitEarly:
End If
Else
blnFlag = True
GoTo ExitEarly:
End If
End If
On Error GoTo 0
'Defining Row and Column
in ResultArray
If CombinationOf =
xlColumn Then
ReDim
VarTemp(LBound(ArrFirst) To UBound(ArrFirst), LBound(ArrFirst, 2) To
(UBound(ArrFirst, 2) + UBound(ArrAdd, 2)))
ElseIf CombinationOf =
xlRow Then
ReDim
VarTemp(LBound(ArrFirst) To (UBound(ArrFirst) + UBound(ArrAdd)),
LBound(ArrFirst, 2) To UBound(ArrFirst, 2))
End If
'Filling First Array in
ResultArray
For lngCol =
LBound(ArrFirst, 2) To UBound(ArrFirst, 2)
For lngRow =
LBound(ArrFirst) To UBound(ArrFirst)
VarTemp(lngRow,
lngCol) = ArrFirst(lngRow, lngCol)
Next lngRow
Next lngCol
If CombinationOf =
xlColumn Then
lngCol = lngCol - 1
lngRow = 0
ElseIf CombinationOf =
xlRow Then
lngRow = lngRow - 1
lngCol = 0
End If
'Filling Second Array in
ResultArray
For lngCol2 =
LBound(ArrAdd) To UBound(ArrAdd, 2)
For lngRow2 =
LBound(ArrAdd) To UBound(ArrAdd)
VarTemp(lngRow2 +
lngRow, lngCol2 + lngCol) = ArrAdd(lngRow2, lngCol2)
Next lngRow2
Next lngCol2
ArrResult = VarTemp
ExitEarly:
If blnFlag Then
ArrResult = Null
CombineArrayElements
= False
Else
CombineArrayElements
= True
End If
End Function
==================================================================================
Function ConvertArrayOneD2TwoD(ArrInput As Variant, ArrOutput As
Variant)
Dim lngCount As Long
Dim VarTemp
ReDim VarTemp(1 To 1, 1
To UBound(ArrInput))
For lngCount =
LBound(ArrInput) To UBound(ArrInput)
VarTemp(1, lngCount)
= ArrInput(lngCount)
Next lngCount
ArrOutput = VarTemp
End Function
Thanks for reading :) Any suggestion and comment would be highly appreciated
Rajan Verma
Monday, July 9, 2012
Friday, July 6, 2012
Fill Array One D to Two D
Below function
used to fill one dimensional array elements to 2D Array based on Given
parameters,
==================================================================================================================================
Enum
Combination
xlRow
xlColumn
End Enum
Enum FillType
FillRowWise
FillColumnWise
End Enum
==================================================================================================================================
Function
JustifyArray(varArrInput As Variant, VarArrResult As Variant, TransformIn As
Combination, HowMany As Long, HowToFill As FillType) As Boolean
Dim lngRow As Long
Dim lngCol As Long
Dim lngTemp As Long
Dim VarTemp()
Dim lngCount
Dim lngRowCount As Long
Dim lngColCount As Long
Dim blnFlag As Boolean
If IsArray(varArrInput) Then
If TransformIn = xlColumn Then
lngCol = HowMany
lngRow = Int(UBound(varArrInput) /
lngCol) + 1
ElseIf TransformIn = xlRow Then
lngRow = HowMany
lngCol = Int(UBound(varArrInput) /
lngRow) + 1
End If
Else
blngFlag = True
End If
If HowToFill = FillColumnWise Then
lngTemp = lngRow
lngRow = lngCol
lngCol = lngTemp
End If
ReDim VarArrResult(lngRow, lngCol)
lngTemp = LBound(varArrInput)
For lngRowCount = 0 To lngRow
For lngColCount = 0 To lngCol
If lngTemp >=
UBound(varArrInput) Then GoTo ExitEarly:
VarArrResult(lngRowCount,
lngColCount) = varArrInput(lngTemp)
lngTemp = lngTemp + 1
Next lngColCount
Next lngRowCount
ExitEarly:
If blnFlag Then
VarArrResult = Null
JustifyArray = False
End If
End Function
==================================================================================================================================
Enjoy Reading ….
Combine Array Elements [Rows or Columns]
here is an updated version of my last function to combine arrays
elements. by using this function user can combine columns as well as rows also
,
Enum Combination
xlRow
xlColumn
End Enum
Private Function CombineArrayCol(ArrFirst As
Variant, ArrAdd As Variant, ArrResult As Variant, CombinationOf As Combination)
As Boolean
'Created By Rajan 4-July-2012
'---------How to
Use-------------------
'Syntex
'CombineArrayCol
FirstArray ,SecondArray ,ResultArray
' FirstArray =
FirstArray is in which second array need to be combine,Must have atleast on
column and Multidimensional
' SecondArray =
SecondArray is which need to combined with FirstArray,Must have atleast on
column and Multidimensional
' ResultArray =
ResultArray is in which combined array will be stored
' CombinationOf
= what you want to Combine either Rows or Columns of Two Arrays
' This Function Return
True if Operation is succesfull and False with NULL Result array if Operation
is Not succeed
Dim blnFlag As Boolean
'Validating Array , IsArray
If CombinationOf = xlColumn
Then
If IsArray(ArrFirst)
And IsArray(ArrAdd) Then ' if Both Parameter is an Array
'Both array must
contain same Row Number
If
UBound(ArrFirst) = UBound(ArrAdd) Then
' Both Array must contain atleast One Column
If UBound(ArrAdd, 2) < 0 Or UBound(ArrFirst, 2) < 0 Then
blnFlag = True
GoTo ExitEarly:
End If
Else
blnFlag = True
GoTo ExitEarly:
End If
Else
blnFlag =
True
GoTo
ExitEarly:
End If
Else
If IsArray(ArrFirst)
And IsArray(ArrAdd) Then ' if Both Parameter is an Array
'Both array must
contain same Columns Number
If
UBound(ArrFirst, 2) = UBound(ArrAdd, 2) Then
' Both Array must contain atleast One Row
If UBound(ArrAdd) < 0 Or UBound(ArrFirst) < 0 Then
blnFlag = True
GoTo ExitEarly:
End If
Else
blnFlag = True
GoTo ExitEarly:
End If
Else
blnFlag =
True
GoTo
ExitEarly:
End If
End If
'Defining Row and Column in
ResultArray
If CombinationOf = xlColumn Then
ReDim
ArrResult(LBound(ArrFirst) To UBound(ArrFirst), LBound(ArrFirst, 2) To
(UBound(ArrFirst, 2) + UBound(ArrAdd, 2)))
ElseIf CombinationOf = xlRow Then
ReDim
ArrResult(LBound(ArrFirst) To (UBound(ArrFirst) + UBound(ArrAdd)), LBound(ArrFirst,
2) To UBound(ArrFirst, 2))
End If
Dim lngRow As Long
Dim lngCol As Long
Dim lngRow2 As Long
Dim lngCol3 As Long
'Filling First Array in ResultArray
For lngCol = LBound(ArrFirst, 2) To
UBound(ArrFirst, 2)
For lngRow =
LBound(ArrFirst) To UBound(ArrFirst)
ArrResult(lngRow, lngCol) = ArrFirst(lngRow, lngCol)
Next lngRow
Next lngCol
If
CombinationOf = xlColumn Then
lngCol = lngCol - 1
lngRow = 0
ElseIf CombinationOf = xlRow Then
lngRow = lngRow - 1
lngCol = 0
End If
'Filling Second Array in ResultArray
For lngCol2 = LBound(ArrAdd) To
UBound(ArrAdd, 2)
For lngRow2 =
LBound(ArrAdd) To UBound(ArrAdd)
ArrResult(lngRow2 + lngRow, lngCol2 + lngCol) = ArrAdd(lngRow2, lngCol2)
Next lngRow2
Next lngCol2
ExitEarly:
If blnFlag Then
ArrResult = Null
CombineArrayCol = False
Else
CombineArrayCol = True
End If
End Function
Enjoy reading..
Rajan
Subscribe to:
Posts (Atom)