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

 

[Rick Rothstein]

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]

While not the "significantly shorter approach" I still think exists, the following more conventionally constructed code is 10 characters shorter in total than the above function which I posted earlier...

Function Positions(R As Range, Val As Variant) As String
  Dim X As Long
  For X = 1 To R.Count
    If R(1).Offset(, X - 1) = Val Then Positions = Positions & "," & X
  Next
  Positions = Mid(Positions, 2)
End Function

 

[Peter_SSs]

Here is another way to write this type of code approach... it is about 16% smaller ..

As usual, for me shorter is not a goal in itself. In this case I would go with your shorter, but only because it is a bit easier to read (there appears to be no significant change in speed).

The shortening of r.Cells(1) to R(1) is really semantics, but if you wanted another slight shortening, you could change
R(1).Column
to
R.Column

While not the "significantly shorter approach" I still think exists, the following more conventionally constructed code is 10 characters shorter in total than the above function which I posted earlier...

Not interested because it is shorter. I am interested because it is about 3 times faster.

Since you do like shorter though, you could make this change (which also increases speed).

<del>If R(1).Offset(, X - 1) = Val Then Positions = Positions & "," & X</del>
If R(X) = Val Then Positions = Positions & "," & X

For another significant increase in speed (about 30% better for me), read the value into an array:

Function pos(R As Range, Val As Variant) As String
  Dim X As Long
  Dim a As Variant
  
  a = R.Value
  For X = 1 To UBound(a, 2)
    If a(1, X) = Val Then pos = pos & "," & X
  Next
  pos = Mid(pos, 2)
End Function

 

[Rick Rothstein]

For another significant increase in speed (about 30% better for me), read the value into an array:

Function pos(R As Range, Val As Variant) As String
  Dim X As Long
  Dim a As Variant
  
  a = R.Value
  For X = 1 To UBound(a, 2)
    If a(1, X) = Val Then pos = pos & "," & X
  Next
  pos = Mid(pos, 2)
End Function

Working together, we make a good team... the OP now has a relatively compact and super fast macro for his application. :wink:

 

[Ombir]

@ 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)

Hi Peter,

I used that approach in near past but forgot this time.Index is slightly faster. Thanks for the reminder.

 

[Rick Rothstein]

[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]

...but I cannot help feeling there is a significantly shorter approach to do this that we are missing

And here it is... not sure how it compares time-wise, but it is compact

[table="width: 500"]
[tr]
	[td]Function Positions(R As Range, Val As String) As String
  Positions = Join(Filter(Evaluate("{1,2,3,4,5,6,7}*(" & R.Address & "=" & Val & ")"), 0, False), ",")
End Function[/td]
[/tr]
[/table]

 

[snb_]

or:

Sub M_snb()
  sn = [if(A1:G7=0,column(A1:G7),"~")]
  
  For j = 1 To UBound(sn)
     sn(j, 1) = Join(Filter(Application.Index(sn, j), "~", 0), ",")
  Next
  
  [I1:I7] = Application.Index(sn, 0, 1)
End Sub

as UDF:

Function F_snb(c00)
    F_snb = Join(Filter(Evaluate("index((" & c00.Address & "=0)*column(" & c00.Address & "),)"), 0, 0), ",")
End Function

 

[snb_]

Revised UDF (provided col <10 ):

Function F_snb(c00)
    F_snb = Join(Filter(Evaluate("(" & c00.Address & "=0)*column(" & c00.Address & ")"), 0, 0), ",")
End Function

or

Function F_snb(c00)
    F_snb = Mid(Join(Evaluate("If(" & c00.Address & "<>0,"""","",""&column(" & c00.Address & "))"), ""), 2)
End Function

 

[Ombir]

  sn = [if(A1:G7=0,column(A1:G7),"~")]

Hi Snb,

This is exactly I was trying from morning but couldn't able figure out to achieve in VBA. This approach is fastest because of writing all cells at once. Thanks for Sharing.

I often visit your website VBA for smarties. It has really informative content with examples, particularly the Dictionary part.

 

[Peter_SSs]

not sure how it compares time-wise

By my testing, all the recent Join(Filter.. functions are at least 3 times slower than the pos() function from post #12.

snb_'s functions only return the correct position in the array if the array begins in column A, which I don't think we have been given information about.

 

[snb_]

@P_S

Why did you assume otherwise ? No information on that either.
When no specific information provided I assume the obvious (default).