rsutton1981
New Member
- Joined
- Mar 9, 2016
- Messages
- 47
- Office Version
- 365
- Platform
- Windows
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
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
VBA 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