Excel Arrays VBA

[rohankekatpure1987]

HI,

In my current assignment I need to develop a comma separated string based on the below example table:

[TABLE="width: 576"]
<colgroup><col width="64" span="9" style="width:48pt"> </colgroup><tbody>[TR]
[TD="width: 64, align: center"][/TD]
[TD="width: 64, align: center"]S[/TD]
[TD="width: 64, align: center"]M[/TD]
[TD="width: 64, align: center"]T[/TD]
[TD="width: 64, align: center"]W[/TD]
[TD="width: 64, align: center"]Th[/TD]
[TD="width: 64, align: center"]F[/TD]
[TD="width: 64, align: center"]S[/TD]
[TD="width: 64, align: center"]Output[/TD]
[/TR]
[TR]
[TD="class: xl85, align: center"]A[/TD]
[TD="align: center"]0[/TD]
[TD="align: center"]1[/TD]
[TD="align: center"]0[/TD]
[TD="align: center"]0[/TD]
[TD="align: center"]0[/TD]
[TD="align: center"]1[/TD]
[TD="align: center"]0[/TD]
[TD="class: xl84, align: center"]1,3,4,5,7[/TD]
[/TR]
[TR]
[TD="class: xl85, align: center"]B[/TD]
[TD="align: center"]1[/TD]
[TD="align: center"]0[/TD]
[TD="align: center"]0[/TD]
[TD="align: center"]1[/TD]
[TD="align: center"]0[/TD]
[TD="align: center"]1[/TD]
[TD="align: center"]0[/TD]
[TD="class: xl84, align: center"]2,3,5,7[/TD]
[/TR]
[TR]
[TD="class: xl85, align: center"]C[/TD]
[TD="align: center"]0[/TD]
[TD="align: center"]0[/TD]
[TD="align: center"]1[/TD]
[TD="align: center"]0[/TD]
[TD="align: center"]1[/TD]
[TD="align: center"]0[/TD]
[TD="align: center"]1[/TD]
[TD="class: xl84, align: center"]1,2,4,6[/TD]
[/TR]
[TR]
[TD="class: xl85, align: center"]D[/TD]
[TD="align: center"]0[/TD]
[TD="align: center"]1[/TD]
[TD="align: center"]1[/TD]
[TD="align: center"]1[/TD]
[TD="align: center"]1[/TD]
[TD="align: center"]1[/TD]
[TD="align: center"]1[/TD]
[TD="class: xl84, align: center"]1[/TD]
[/TR]
[TR]
[TD="class: xl85, align: center"]E[/TD]
[TD="align: center"]1[/TD]
[TD="align: center"]1[/TD]
[TD="align: center"]1[/TD]
[TD="align: center"]1[/TD]
[TD="align: center"]1[/TD]
[TD="align: center"]1[/TD]
[TD="align: center"]1[/TD]
[TD="class: xl84, align: center"]0[/TD]
[/TR]
[TR]
[TD="class: xl85, align: center"]F[/TD]
[TD="align: center"]1[/TD]
[TD="align: center"]1[/TD]
[TD="align: center"]1[/TD]
[TD="align: center"]1[/TD]
[TD="align: center"]1[/TD]
[TD="align: center"]1[/TD]
[TD="align: center"]1[/TD]
[TD="class: xl84, align: center"]0[/TD]
[/TR]
[TR]
[TD="class: xl85, align: center"]G[/TD]
[TD="align: center"]1[/TD]
[TD="align: center"]1[/TD]
[TD="align: center"]0[/TD]
[TD="align: center"]1[/TD]
[TD="align: center"]1[/TD]
[TD="align: center"]1[/TD]
[TD="align: center"]1[/TD]
[TD="class: xl84, align: center"]3[/TD]
[/TR]
</tbody>[/TABLE]

A,B...G rows and S,M,T,W,Th,F,S are columns. My data has either 1 or zero.
For each row I need to check at what position zero is present. In row A, 0 is present at S,T,W,Th and S so output is position 1,2,4,5,7.
Can some one please help in generating a comma separated string in Output using VBA or excel formulas.

Thanks!!
Rk

 

[Trebor76]

Try this User Defined Function (UDF):

Option Explicit
Function MatchLocation(rngRange As Range, varItem As Variant) As String

    Dim rngMyCell As Range
    Dim lngMyColCounter As Long
        
    For Each rngMyCell In rngRange
        lngMyColCounter = lngMyColCounter + 1
        If rngMyCell.Value = varItem Then
            If MatchLocation = "" Then
                MatchLocation = lngMyColCounter
            Else
                MatchLocation = MatchLocation & "," & lngMyColCounter
            End If
        End If
    Next rngMyCell
    
    If MatchLocation = "" Then MatchLocation = 0

End Function

Note once copied into the Visual Basic Editor you would use like any other native Excel function like so:

=MatchLocation(A2:G2,0)

where A2:G2 (can be any range) is checked for zeros (can be anything).

HTH

Robert

 

[rohankekatpure1987]

Thanks for your help Robert!!!

 

[Peter_SSs]

Here is another UDF to consider.

Function Positions(r As Range, val As String) As String
  Positions = Join(Filter(Evaluate(Replace(Replace(Replace("if(#=^,column(#)-column(%)+1,""x"")", "#", r.Address), "%", r.Cells(1).Address), "^", val)), "x", False), ",")
End Function

Excel Workbook
	C	D	E	F	G	H	I	J
1	S	M	T	W	Th	F	S	Output
2	0	1	0	0	0	1	0	1,3,4,5,7
3	1	0	0	1	0	1	0	2,3,5,7
4	0	0	1	0	1	0	1	1,2,4,6
5	0	1	1	1	1	1	1	1
6	1	1	1	1	1	1	1
7	1	1	1	1	1	1	1
8	1	1	0	1	1	1	1	3
Sheet2

If you really want "0" returned for rows like 6 and 7, then add the following code into the udf just before the End Function line

If Len(Positions) = 0 Then Positions = 0

 

[Ombir]

For input data in Columns A to G and Output in H, you can also try this:

Sub rohan()
Dim ar          As Variant
Dim x           As String
Dim i            As Long

For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
    ar = Application.Transpose(Application.Transpose(Cells(i, 1).Resize(, 7)))
    For j = LBound(ar) To UBound(ar)
        If ar(j) = 0 Then x = x & j & ","
    Next
    Range("H" & i) = Trim(IIf(Len(x) > 1, Left(x, Len(x) - 1), 0)): x = " "
Next
End Sub

 

[wideboydixon]

Without macro:

Book1
	A	B	C	D	E	F	G	H
1	S	M	T	W	Th	F	S	Result
2	0	1	0	0	0	1	0	1,3,4,5,7
3	1	0	0	1	0	1	0	2,3,5,7
4	0	0	1	0	1	0	1	1,2,4,6
5	0	1	1	1	1	1	1	1
6	1	1	1	1	1	1	1	0
7	1	1	1	1	1	1	1	0
8	1	1	0	1	1	1	1	3
Sheet1

Cell Formulas
Range	Formula
H2	=SUBSTITUTE(IF(SUM(A2:G2)=7,",0",IF(A2=0,",1","")&IF(B2=0,",2","")&IF(C2=0,",3","")&IF(D2=0,",4","")&IF(E2=0,",5","")&IF(F2=0,",6","")&IF(G2=0,",7","")),",","",1)

WBD

 

[Trebor76]

Thanks for your help Robert!!!

You're welcome Looks like you've got a number of other great solutions as well

Regards,

Robert

 

[rohankekatpure1987]

You're welcome Looks like you've got a number of other great solutions as well

Regards,

Robert

Yes. Thank you everyone for the help. Really interesting on how Peter created a one liner solution.

 

[Peter_SSs]

@ Ombir

ar = Application.Transpose(Application.Transpose(Cells(i, 1).Resize(, 7)))

Another way to fill that same array without having to do the double transpose is

ar = Application.Index(Cells(i, 1).Resize(, 7).Value, 1, 0)

 

[Rick Rothstein]

Here is another UDF to consider.

Function Positions(r As Range, val As String) As String
  Positions = Join(Filter(Evaluate(Replace(Replace(Replace("if(#=^,column(#)-column(%)+1,""x"")", "#", r.Address), "%", r.Cells(1).Address), "^", val)), "x", False), ",")
End Function

[/code]

Here is another way to write this type of code approach... it is about 16% smaller than your code (but I cannot help feeling there is a significantly shorter approach to do this that we are missing).

[table="width: 500"]
[tr]
	[td]Function Positions(R As Range, Val As Variant) As String
  Positions = Replace(Application.Trim(Join(Evaluate(Replace("IF(@=" & Val & ",COLUMN(@)-" & R(1).Column & "+1,"""")", "@", R.Address)))), " ", ",")
End Function[/td]
[/tr]
[/table]