Scripting Dictionary

[rsutton1981]

Hi,

using some code that was posted on these forums and some modifications I have some VBA that looks for a specific value in Column B, then finds the rows with the same value in a different sheet (Database), copies them and pastes them to another sheet (Risk Selection). However, when it moves to the next value in column B and does the look up it pastes the data over, it places it over the previously places data rather then using an empty row.

Can anyone see where I may have missed something in the code

Sub search()
   Dim Dic As Object
   Dim Cl As Range
   Dim wsRA As Worksheet
   
   Set wsRA = Sheets("Risk Assessment")
   Set Dic = CreateObject("scripting.dictionary")
   With Sheets("Database")
      For Each Cl In .Range("B2", .Range("B" & Rows.Count).End(xlUp))
         If Not Dic.Exists(Cl.Value) Then
            Dic.Add Cl.Value, Cl
         Else
            Set Dic(Cl.Value) = Union(Cl, Dic(Cl.Value))
         End If
      Next Cl
   End With
   With Sheets("Risk Selection")
      For Each Cl In .Range("B6", .Range("B" & Rows.Count).End(xlUp))
         If Dic.Exists(Cl.Value) Then
            Dic(Cl.Value).EntireRow.Copy wsRA.Range("A" & Rows.Count).End(xlUp).Offset(1)
         End If
      Next Cl
   End With
End Sub

 

[Fluff]

Does column A on the Risk sheet have values on every row?

 

[rsutton1981]

Does column A on the Risk sheet have values on every row?

no, but column B will always have a value

 

[Fluff]

In that case use

Dic(Cl.Value).EntireRow.Copy wsRA.Range("B" & Rows.Count).End(xlUp).Offset(1)

 

[rsutton1981]

it comes back saying that the copy and paste area are not the same size

 

[Fluff]

Oops, should be

Dic(Cl.Value).EntireRow.Copy wsRA.Range("B" & Rows.Count).End(xlUp).Offset(1, -1)

 

[rsutton1981]

Fluff, that works great. Thank you.

 

[Fluff]

You're welcome & thanks for the feedback.