Sep 7, 2008

How Multi Range CONCATENATE (UDF STRJOIN)

   Hi ! Here Suggest to you

 [ Multi Range CONCATENATE ] Let's Look & Find
   --->
   Use - 1 STRJOIN (text1,text2,...)

   Default JoinString = ,

   Use - 2 STRJOIN (text1,text2,.... JoinString)
21 
22 
23 
24 
25 
26 
27 
28 
29 
30 
31 
32 
33 
34 
35 
36 
37 
ABCDE
ADec/31/2008/
B0.12 
CF 
D  
   
A,Dec/31/2008,/,B,0.12,C,F,D
       Join With "," Default String
A,Dec/31/2008,/,B,C,D
       Join With "," Default String
A,Dec/31/2008,B,0.12,D,/
       Join With "," Default String
A/Dec/31/2008/B/0.12/D
       Join With "/" User String
A Dec/31/2008 B 0.12 D
       Join With " " User String
A , Dec/31/2008 , B , 0.12 , D
       Join With " , " User String

Used Formula ...(With Running MicrosoftExcel Ver 2003)
NoAddr'  If use below Formula, You'll Get Result as RightResultEtc
1A26=STRJOIN(A21:E24)A,Dec/31/2008,/,B,0.12,C,F,D 
2A28=STRJOIN(21:21,A22:A24)A,Dec/31/2008,/,B,C,D 
3A30=STRJOIN(A21:C22,A24,E21)A,Dec/31/2008,B,0.12,D,/ 
4A32=STRJOIN(A21:C22,A24,TEXT(E21,"#"))A/Dec/31/2008/B/0.12/D 
5A34=STRJOIN(A21:C22,A24," ")A Dec/31/2008 B 0.12 D 
6A36=STRJOIN(A21:C22,A24," , ")A , Dec/31/2008 , B , 0.12 , D 

      How about this suggest?

Option Explicit

Function STRJOIN(ParamArray VariantR())
Dim i As Double, j As Double
Dim AddStr     As String
Dim MaxB       As Double
Dim AnsS()     As String
Dim ChkStrN    As Double
     MaxB = UBound(VariantR)

If TypeName(VariantR(MaxB)) = "RangeThen
     AddStr = Chr(65000) & "," & Chr(65000)
Else
     AddStr = Chr(65000) & VariantR(MaxB) & Chr(65000)
     MaxB = MaxB - 1
End If

ReDim AnsS(MaxB) As String
     ChkStrN = Len(AddStr)
Dim r As Range
For i = 0 To MaxB
     If TypeName(VariantR(i)) = "RangeThen
     If VariantR(i).Count > 1 Then
          Set r = VariantR(i)
          AnsS(i) = MVV(r, AddStr)
          Else
          AnsS(i) = VariantR(i)
          End If
     Else
          AnsS(i) = VariantR(i)
     End If
Next
     STRJOIN = Join(AnsS, AddStr)
If InStr(STRJOIN, AddStr) = 1 Then
STRJOIN = Mid(STRJOIN, ChkStrN + 1)
ElseIf Right(STRJOIN, ChkStrN) = AddStr Then
STRJOIN = Left(STRJOIN, Len(STRJOIN) - ChkStrN)
End If
     STRJOIN = Replace(STRJOIN, Chr(65000), "")
End Function

Function MVV(tmpV As Range, tmpStr As String)
Dim ii As Double
Dim jj As Double
Dim kk As Double
Dim LB1 As Double, LB2 As Double
Dim AnsY
LB1 = tmpV.Rows.Count
LB2 = tmpV.Columns.Count
ReDim AnsY(1 To 1)
     For ii = 1 To LB1
     For jj = 1 To LB2
          If CStr(tmpV(ii, jj)) <> "" Then
               kk = kk + 1
               ReDim Preserve AnsY(1 To kk)
               AnsY(kk) = tmpV(ii, jj).Text
          End If
     Next
     Next
MVV = Join(AnsY, tmpStr)
End Function

Any Bug Or Ask ... Mail Or Post Reply

Sep 5, 2008

How Use SUMIFS(2007) Function in Excel 2003 (UDF SUMIFS2003)

   Hi ! Here Suggest to you

 [ In 2007 Let's Use 2003 SUMIFS ] Let's Look & Find
   Use =SUMIFS2003(SumRange, Range,Condition, Range,Condition...)
10 
11 
12 
13 
14 
15 
16 
17 
18 
19 
20 
21 
22 
23 
24 
25 
26 
ABCGHI
NameWorkedBonusCondition 1Condition 2Condition 3
KimHomes100Kimhomes200
SamBranch110SummaryCheck
ManOffice120320320TRUE
KKoHomes130320320TRUE
KimBranch14000TRUE
SamOffice150500500TRUE
ManHomes160500500TRUE
KKoBranch17000TRUE
KimOffice180460460TRUE
SamHomes190460460TRUE
ManBranch20000TRUE
KKoOffice210320320TRUE
KimHomes220320320TRUE
SamBranch230420420TRUE
KKoBranch290420420TRUE
2600

Used Formula ...(With Running MicrosoftExcel Ver 2003)
NoAddr'  If use below Formula, You'll Get Result as RightResultEtc
1C26=SUM(C11:C25)2600
2G13=SUMPRODUCT(($A$11:$A$25=G11)*($B$11:$B$25=H11),$C$11:$C$25)320
3G14=SUMPRODUCT(($A$11:$A$25="Kim")*($B$11:$B$25="Homes"),$C$11:$C$25)320
4G15=SUMPRODUCT(($A$11:$A$25="=G11")*($B$11:$B$25="=H11"),$C$11:$C$25)0
5G16=SUMPRODUCT(($A$11:$A$25=G11)*($B$11:$B$25>=H11),$C$11:$C$25)500
6G17=SUMPRODUCT(($A$11:$A$25="Kim")*($B$11:$B$25>="Homes"),$C$11:$C$25)500
7G18=SUMPRODUCT(($A$11:$A$25="=G11")*($B$11:$B$25>="=H11"),$C$11:$C$25)0
8G19=SUMPRODUCT(($A$11:$A$25=G11)*($B$11:$B$25< =H11),$C$11:$C$25)460
9G20=SUMPRODUCT(($A$11:$A$25="Kim")*($B$11:$B$25< ="Homes"),$C$11:$C$25)460
10G21=SUMPRODUCT(($A$11:$A$25="=G11")*($B$11:$B$25< ="=H11"),$C$11:$C$25)0
11G22=SUMPRODUCT(($A$11:$A$25=G11)*($B$11:$B$25< >H11),$C$11:$C$25)320
12G23=SUMPRODUCT(($A$11:$A$25="Kim")*($B$11:$B$25< >"Homes"),$C$11:$C$25)320
13G24=SUMPRODUCT(($A$11:$A$25=G11)*($C$11:$C$25< =200),$C$11:$C$25)420
14G25=SUMPRODUCT(($A$11:$A$25=G11)*($C$11:$C$25< =I11),$C$11:$C$25)420
15H13=SUMIFS2003($C$11:$C$25,$A$11:$A$25,G11,$B$11:$B$25,H11)320
16H14=SUMIFS2003($C$11:$C$25,$A$11:$A$25,"Kim",$B$11:$B$25,"Homes")320
17H15=SUMIFS2003($C$11:$C$25,$A$11:$A$25,"=G11",$B$11:$B$25,"=H11")0
18H16=SUMIFS2003($C$11:$C$25,$A$11:$A$25,G11,$B$11:$B$25,">="&H11)500
19H17=SUMIFS2003($C$11:$C$25,$A$11:$A$25,"Kim",$B$11:$B$25,">=Homes")500
20H18=SUMIFS2003($C$11:$C$25,$A$11:$A$25,"=G11",$B$11:$B$25,">="&"H11")0
21H19=SUMIFS2003($C$11:$C$25,$A$11:$A$25,G11,$B$11:$B$25,"< ="&H11)460
22H20=SUMIFS2003($C$11:$C$25,$A$11:$A$25,"Kim",$B$11:$B$25,"< =Homes")460
23H21=SUMIFS2003($C$11:$C$25,$A$11:$A$25,"=G11",$B$11:$B$25,"< ="&"H11")0
24H22=SUMIFS2003($C$11:$C$25,$A$11:$A$25,G11,$B$11:$B$25,"< >"&H11)320
25H23=SUMIFS2003($C$11:$C$25,$A$11:$A$25,"Kim",$B$11:$B$25,"< >Homes")320
26H24=SUMIFS2003($C$11:$C$25,$A$11:$A$25,G11,$C$11:$C$25,"< =200")420
27H25=SUMIFS2003($C$11:$C$25,$A$11:$A$25,"Kim",$C$11:$C$25,"< ="&I11)420
28I13=G13=H13TRUE
29 I13  His Formula Used This Cell  -> I13:I25

     if Formula occurs Error! or Different Result...Check or Remove the Space in Formula.

      How about this suggest?

In 2007 Let's Use 2003 SUMIFS
Use  =SUMIFS2003(SumRangeRange,Condition, Range,Condition...)

Function SUMIFS2003(sumarr As RangeParamArray var() As Variant)
On Error Resume Next
Dim i7 As Double, LB As Double, UB As Double
Dim adr As Variant
     LB = LBound(var)
     UB = UBound(var)
If UB Mod 2 = 0 Then
     SUMIFS2003 = "Sum / Condition1,2 / 3,4"
     Exit Function
End If
ReDim adr(LB To UB)
For i7 = LB To UB Step 2
     adr(i7) = RT(var(i7), var(i7 + 1))
Next
     adr(0) = RT(sumarr, "") & adr(0)
     
SUMIFS2003 = "=SUMPRODUCT(--(" & Join(adr, "),--(") & ")"
For i7 = LB To UB
     SUMIFS2003 = Replace(SUMIFS2003, "--(),", "")
Next
     SUMIFS2003 = Replace(SUMIFS2003, ",--()", ")")
     SUMIFS2003 = Application.Evaluate(SUMIFS2003)
End Function


Function RT(vv, cc)
On Error Resume Next
RT = Application.Evaluate(cc)
If CStr(cc) = "" Then
          RT = "" & vv.Address(External:=True) & "),--("
Else
     If Not (IsError(RT)) Then
          If IsEmpty(RT) Then
               RT = vv.Address(External:=True) & "=""" & cc & """"
          ElseIf IsNumeric(RT) Then
               RT = vv.Address(External:=True) & "=" & cc
          ElseIf IsDate(RT) Then
               RT = vv.Address(External:=True) & "=" & cc
          ElseIf TypeName(Range(cc)) = "RangeThen
               If IsNumeric(RT) Then
                    RT = vv.Address(External:=True) & "=" & cc
               Else
                    RT = vv.Address(External:=True) & "=""" & cc & """"
               End If
          Else
               If IsNumeric(RT) Then
                    RT = vv.Address(External:=True) & RT
               ElseIf IsDate(RT) Then
                    RT = vv.Address(External:=True) & RT
               Else
                    RT = vv.Address(External:=True) & "=""" & RT & """"
               End If
          End If
     Else
     Select Case RT
          Case CVErr(xlErrDiv0):   GoTo ers
          Case CVErr(xlErrNA):     GoTo ers
          Case CVErr(xlErrName):   GoTo ers
          Case CVErr(xlErrNull):   GoTo ers
          Case CVErr(xlErrNum):    GoTo ers
          Case CVErr(xlErrRef):    GoTo ers
          Case CVErr(xlErrValue):  GoTo ers
     End Select
     End If
End If
Exit Function
ers:
If Err.Number = 13 Then
     RT = "--(" & vv.Address(External:=True) & "),"""" & cc & """""
Else
     If IsNumeric(cc) Then
          RT = vv.Address(External:=True) & "=" & cc
     Else
          RT = vv.Address(External:=True) & GetRT(cc)
     End If
End If
End Function

Function GetRT(RTstr)
Dim RTtemp1     As String
Dim RTtemp2    As String
Dim RTLeft     As String
     RTLeft = Left(RTstr, 1)
     RTtemp1 = Mid(RTstr, 2)
     RTtemp2 = Mid(RTtemp1, 2)
If IsNumeric(RTtemp1) Then
ElseIf IsDate(RTtemp1) Then
Else
     RTtemp1 = """" & RTtemp1 & """"
End If

If IsNumeric(RTtemp2) Then
ElseIf IsDate(RTtemp2) Then
Else
     RTtemp2 = """" & RTtemp2 & """"
End If

Select Case Left(RTstr, 2)
Case ">=":     GetRT = ">=" & RTtemp2
Case "=>":     GetRT = ">=" & RTtemp2
Case "<=":     GetRT = "<=" & RTtemp2
Case "=<":     GetRT = "<=" & RTtemp2
Case "<>":     GetRT = "<>" & RTtemp2
Case Else
     Select Case RTLeft
     Case "=": GetRT = "=" & RTtemp1
     Case ">": GetRT = ">" & RTtemp1
     Case "<": GetRT = "<" & RTtemp1
     Case Else
          If IsNumeric(RTstr) Then
               GetRT = "=" & RTstr
          Else
               GetRT = "=""" & RTstr & """"
          End If
     End Select
End Select
End Function

Any Bug Or Ask ... Mail Or Post Reply

How Use COUNTIFS(2007) Function in Excel 2003 (UDF COUNTIFS2003)

   Hi ! Here Suggest to you

 [ In 2007 Let's Use 2003 COUNTIFS Use ] Let's Look & Find
   =COUNTIFS2003(Range,Condition, Range,Condition, ...)
10 
11 
12 
13 
14 
15 
16 
17 
18 
19 
20 
21 
22 
23 
24 
25 
26 
ABCDEF
NameWorkedBonusCondition 1Condition 2Condition 3
KimHomes100kimHomes200
SamBranch110CountCheck
ManOffice12022TRUE
KKoHomes13022TRUE
KimBranch14000TRUE
SamOffice15033TRUE
ManHomes16033TRUE
KKoBranch17000TRUE
KimOffice18033TRUE
SamHomes19033TRUE
ManBranch20000TRUE
KKoOffice21022TRUE
KimHomes22022TRUE
SamBranch23033TRUE
KKoBranch29033TRUE
2600

Used Formula ...(With Running MicrosoftExcel Ver 2003)
NoAddr'  If use below Formula, You'll Get Result as RightResultEtc
1C26=SUM(C11:C25)2600
2D13=SUMPRODUCT(($A$11:$A$25=D11)*($B$11:$B$25=E11))2
3D14=SUMPRODUCT(($A$11:$A$25="Kim")*($B$11:$B$25="Homes"))2
4D15=SUMPRODUCT(($A$11:$A$25="=D11")*($B$11:$B$25="=E11"))0
5D16=SUMPRODUCT(($A$11:$A$25=D11)*($B$11:$B$25>=E11))3
6D17=SUMPRODUCT(($A$11:$A$25="Kim")*($B$11:$B$25>="Homes"))3
7D18=SUMPRODUCT(($A$11:$A$25="=D11")*($B$11:$B$25>="=E11"))0
8D19=SUMPRODUCT(($A$11:$A$25=D11)*($B$11:$B$25< =E11))3
9D20=SUMPRODUCT(($A$11:$A$25="Kim")*($B$11:$B$25< ="Homes"))3
10D21=SUMPRODUCT(($A$11:$A$25="=D11")*($B$11:$B$25< ="=E11"))0
11D22=SUMPRODUCT(($A$11:$A$25=D11)*($B$11:$B$25< >E11))2
12D23=SUMPRODUCT(($A$11:$A$25="Kim")*($B$11:$B$25< >"Homes"))2
13D24=SUMPRODUCT(($A$11:$A$25=D11)*($C$11:$C$25< =200))3
14D25=SUMPRODUCT(($A$11:$A$25=D11)*($C$11:$C$25< =F11))3
15E13=COUNTIFS2003($A$11:$A$25,D11,$B$11:$B$25,E11)2
16E14=COUNTIFS2003($A$11:$A$25,"Kim",$B$11:$B$25,"Homes")2
17E15=COUNTIFS2003($A$11:$A$25,"=D11",$B$11:$B$25,"=E11")0
18E16=COUNTIFS2003($A$11:$A$25,D11,$B$11:$B$25,">="&E11)3
19E17=COUNTIFS2003($A$11:$A$25,"Kim",$B$11:$B$25,">=Homes")3
20E18=COUNTIFS2003($A$11:$A$25,"=D11",$B$11:$B$25,">="&"E11")0
21E19=COUNTIFS2003($A$11:$A$25,D11,$B$11:$B$25,"< ="&E11)3
22E20=COUNTIFS2003($A$11:$A$25,"Kim",$B$11:$B$25,"< =Homes")3
23E21=COUNTIFS2003($A$11:$A$25,"=D11",$B$11:$B$25,"< ="&"E11")0
24E22=COUNTIFS2003($A$11:$A$25,D11,$B$11:$B$25,"< >"&E11)2
25E23=COUNTIFS2003($A$11:$A$25,"Kim",$B$11:$B$25,"< >Homes")2
26E24=COUNTIFS2003($A$11:$A$25,D11,$C$11:$C$25,"< =200")3
27E25=COUNTIFS2003($A$11:$A$25,"Kim",$C$11:$C$25,"< ="&F11)3
28F13=D13=E13TRUE
29 F13  His Formula Used This Cell  -> F13:F25

     if Formula occurs Error! or Different Result...Check or Remove the Space in Formula.

      How about this suggest?

In 2007 Let's Use 2003 COUNTIFS
Use  =COUNTIFS2003(Range,Condition, Range,Condition, ...)

Function COUNTIFS2003(ParamArray var() As Variant)
On Error Resume Next
Dim i7 As Double, LB As Double, UB As Double
Dim adr As Variant
     LB = LBound(var)
     UB = UBound(var)
If UB Mod 2 = 0 Then
     COUNTIFS2003 = "Condition1,2 / 3,4"
     Exit Function
End If
ReDim adr(LB To UB)
For i7 = LB To UB Step 2
     adr(i7) = RT(var(i7), var(i7 + 1))
Next
     
COUNTIFS2003 = "=SUMPRODUCT(--(" & Join(adr, "),--(") & ")"
For i7 = LB To UB
     COUNTIFS2003 = Replace(COUNTIFS2003, "--(),", "")
Next
     COUNTIFS2003 = Replace(COUNTIFS2003, ",--()", ")")
     COUNTIFS2003 = Application.Evaluate(COUNTIFS2003)
End Function



Function RT(vv, cc)
On Error Resume Next
RT = Application.Evaluate(cc)
If CStr(cc) = "" Then
          RT = "" & vv.Address(External:=True) & "),--("
Else
     If Not (IsError(RT)) Then
          If IsEmpty(RT) Then
               RT = vv.Address(External:=True) & "=""" & cc & """"
          ElseIf IsNumeric(RT) Then
               RT = vv.Address(External:=True) & "=" & cc
          ElseIf IsDate(RT) Then
               RT = vv.Address(External:=True) & "=" & cc
          ElseIf TypeName(Range(cc)) = "RangeThen
               If IsNumeric(RT) Then
                    RT = vv.Address(External:=True) & "=" & cc
               Else
                    RT = vv.Address(External:=True) & "=""" & cc & """"
               End If
          Else
               If IsNumeric(RT) Then
                    RT = vv.Address(External:=True) & RT
               ElseIf IsDate(RT) Then
                    RT = vv.Address(External:=True) & RT
               Else
                    RT = vv.Address(External:=True) & "=""" & RT & """"
               End If
          End If
     Else
     Select Case RT
          Case CVErr(xlErrDiv0):   GoTo ers
          Case CVErr(xlErrNA):     GoTo ers
          Case CVErr(xlErrName):   GoTo ers
          Case CVErr(xlErrNull):   GoTo ers
          Case CVErr(xlErrNum):    GoTo ers
          Case CVErr(xlErrRef):    GoTo ers
          Case CVErr(xlErrValue):  GoTo ers
     End Select
     End If
End If
Exit Function
ers:
If Err.Number = 13 Then
     RT = "--(" & vv.Address(External:=True) & "),"""" & cc & """""
Else
     If IsNumeric(cc) Then
          RT = vv.Address(External:=True) & "=" & cc
     Else
          RT = vv.Address(External:=True) & GetRT(cc)
     End If
End If
End Function

Function GetRT(RTstr)
Dim RTtemp1     As String
Dim RTtemp2    As String
Dim RTLeft     As String
     RTLeft = Left(RTstr, 1)
     RTtemp1 = Mid(RTstr, 2)
     RTtemp2 = Mid(RTtemp1, 2)
If IsNumeric(RTtemp1) Then
ElseIf IsDate(RTtemp1) Then
Else
     RTtemp1 = """" & RTtemp1 & """"
End If

If IsNumeric(RTtemp2) Then
ElseIf IsDate(RTtemp2) Then
Else
     RTtemp2 = """" & RTtemp2 & """"
End If

Select Case Left(RTstr, 2)
Case ">=":     GetRT = ">=" & RTtemp2
Case "=>":     GetRT = ">=" & RTtemp2
Case "<=":     GetRT = "<=" & RTtemp2
Case "=<":     GetRT = "<=" & RTtemp2
Case "<>":     GetRT = "<>" & RTtemp2
Case Else
     Select Case RTLeft
     Case "=": GetRT = "=" & RTtemp1
     Case ">": GetRT = ">" & RTtemp1
     Case "<": GetRT = "<" & RTtemp1
     Case Else
          If IsNumeric(RTstr) Then
               GetRT = "=" & RTstr
          Else
               GetRT = "=""" & RTstr & """"
          End If
     End Select
End Select
End Function

Any Bug Or Ask ... Mail Or Post Reply

Sep 4, 2008

How Use IFERROR(2007) Function in Excel 2003 (UDF IFERROR2003)

   Hi ! Here Suggest to you

 [ In 2007 Let's Use 2003 IFERROR ] Let's Look & Find
10 
ABCDEF
NameTelFinderAnswer
Kim101kim101101
Hong304johanNoneNone
Jhon502hong304304

Used Formula ...(With Running MicrosoftExcel Ver 2003)
NoAddr'  If use below Formula, You'll Get Result as RightResultEtc
1E8=IF(ISERROR(VLOOKUP(D8,$A$8:$B$10,2,0)),"None",VLOOKUP(D8,$A$8:$B$10,2,0))101
2 E8  His Formula Used This Cell  -> E8:E10
3F8=IFERROR2003(VLOOKUP(D8,$A$8:$B$10,2,0),"None")101
4 F8  His Formula Used This Cell  -> F8:F10

      How about this suggest?


Function IFERROR2003(WriteFormula, WriteAnswer)
Dim Answ As Variant
On Error Resume Next
Answ = Application.Evaluate(WriteFormula)
If Not (IsError(Answ)) Then
     IFERROR2003 = Answ
Else
Select Case Answ
     Case CVErr(xlErrDiv0):   IFERROR2003 = WriteAnswer
     Case CVErr(xlErrNA):     IFERROR2003 = WriteAnswer
     Case CVErr(xlErrName):   IFERROR2003 = WriteAnswer
     Case CVErr(xlErrNull):   IFERROR2003 = WriteAnswer
     Case CVErr(xlErrNum):    IFERROR2003 = WriteAnswer
     Case CVErr(xlErrRef):    IFERROR2003 = WriteAnswer
     Case CVErr(xlErrValue):  IFERROR2003 = WriteAnswer
     Case Else:               IFERROR2003 = Answ
End Select
End If
End Function

Any Bug Or Ask ... Mail Or Post Reply

Sep 2, 2008

How Use Replace Function in Excel 97 (UDF Replace97)

Function Replace97(OriStr As Variant, _
               Str1 As String,  Str2 As String, _
               Optional Pos As  Double = 1)
Dim i9 As Double
Dim Fn As WorksheetFunction
Set Fn = Application.WorksheetFunction
If Pos = 1 Then
    Replace97 = Fn.Substitute(OriStr, Str1, Str2)
Else
Replace97 = OriStr
    For i9 = Pos To Len(OriStr)
    Replace97 = Fn.Substitute(Replace97, Str1, Str2, i9)
    Next
End If
End Function
Locations of visitors to this page