Clever Geek Handbook

Remove duplicates, merged, from above

I have coded the following macro, it works when I store the values ​​in the immediate window, but don't know how to fill the "," separated values ​​into one cell. Basically I'm looking for "Active" in a column, and if found, move 4 cells to the left and grab information from there ... Could you help?

Dim Active() As Variant
Dim i
ReDim Active(Range("G9:G24").Cells.Count)
For Each Zelle In Range("G9:G24")
If InStr(1, Zelle, "Active") <> 0 Then
Active(i) = Zelle.Offset(0, -4)
End If
i = i + 1
Next Zelle

 For i = LBound(Active) To UBound(Active)
 If Trim(Active(i)) <> "" Then
   Debug.Print Active(i)
   End If
  Next i
  End Sub
+3


source to share


2 answers


you can greatly shorten your code by going through the cells of the required range corresponding to nonblank cells only in column C



    Dim Zelle As Range
    Dim resultStrng As String

    For Each Zelle In Range("G9:G24").Offset(,-4).SpecialCells(xlCellTypeConstants) '<--| loop through not blank cell in range 4 columns to the left of G9:G24
        If InStr(1, Zelle.Offset(, 4), "Active") <> 0 And Trim(Zelle) <> "" And Instr(resultStrng, Trim(Zelle)) =0 Then resultStrng = resultStrng & Trim(Zelle) & "," '<--| update your result string whenever current cell has a character and its 4 columns to the right offset cell meets the "Active" criteria
    Next Zelle
    If resultStrng <> "" Then resultStrng = Left(resultStrng, Len(resultStrng) - 1) '<-- remove the last comma from 'resultStrng'
+1


source


Add next

Dim s As String

Then we rewrite the loop as follows:



For i = LBound(Active) To UBound(Active)
    If Trim(Active(i)) <> "" Then
        s = s & IIf(Len(s)>0, ",", "") & trim(Active(i))
      End If
Next i

Then you can assign to the s

cell.

+2


source






More articles:


All Articles