Macro too long

[John21]

Hi,

is there a way to do the same thing that is doing this code, but in
more general way because this is taking the 64K availables in th
macro


Set RngColD = Range("D2", Range("D" & Rows.Count).End(xlUp))
Info = ""
For Each i In RngColD
If i.Value = Range("A493").Value Then
If Info = "" Then
Info = i.Offset(, 20).Value
Else
Info = Info & "," & i.Offset(, 20).Value
End If
End If
Next i
Range("S493") = Info
Info = ""

Set RngColD = Range("D2", Range("D" & Rows.Count).End(xlUp))
Info = ""
For Each i In RngColD
If i.Value = Range("A494").Value Then
If Info = "" Then
Info = i.Offset(, 20).Value
Else
Info = Info & "," & i.Offset(, 20).Value
End If
End If
Next i
Range("S494") = Info
Info = ""

Set RngColD = Range("D2", Range("D" & Rows.Count).End(xlUp))
Info = ""
For Each i In RngColD
If i.Value = Range("A495").Value Then
If Info = "" Then
Info = i.Offset(, 20).Value
Else
Info = Info & "," & i.Offset(, 20).Value
End If
End If
Next i
Range("S495") = Info
Info = ""

Set RngColD = Range("D2", Range("D" & Rows.Count).End(xlUp))
Info = ""
For Each i In RngColD
If i.Value = Range("A496").Value Then
If Info = "" Then
Info = i.Offset(, 20).Value
Else
Info = Info & "," & i.Offset(, 20).Value
End If
End If
Next i
Range("S496") = Info
Info = ""

Set RngColD = Range("D2", Range("D" & Rows.Count).End(xlUp))
Info = ""
For Each i In RngColD
If i.Value = Range("A497").Value Then
If Info = "" Then
Info = i.Offset(, 20).Value
Else
Info = Info & "," & i.Offset(, 20).Value
End If
End If
Next i
Range("S497") = Info
Info = "

 

[Bob Phillips]

Set RngColD = Range("D2", Range("D" & Rows.Count).End(xlUp))

For j = 494 To 497
Info = ""
For Each i In RngColD
If i.Value = Range("A" & j).Value Then
If Info = "" Then
Info = i.Offset(, 20).Value
Else
Info = Info & "," & i.Offset(, 20).Value
End If
End If
Next i
Range("S" & j) = Info
Next j


--
HTH

Bob Phillips

(replace somewhere in email address with gmail if mailing direct)

 

[Guest]

Dim rng as Range, cell as Range
Dim RngColD as Range, i as Range
Dim Info as String
set rng = Range(Range("A493"),Range("493").End(xldown))
Set RngColD = Range("D2", Range("D" & Rows.Count).End(xlUp))
for each cell in rng
Info = ""
For Each i In RngColD
If i.Value = cell.Value Then
If Info = "" Then
Info = i.Offset(, 20).Value
Else
Info = Info & "," & i.Offset(, 20).Value
End If
End If
Next i
cells(cell.row,"S").Value = Info
Next Cell

 

[Guest]

set rng = Range(Range("A493"),Range("493").End(xldown))


should be

set rng = Range(Range("A493"),Range("A493").End(xldown))