Look up and copy

rsutton1981

New Member
Joined
Mar 9, 2016
Messages
47
Office Version
  1. 365
Platform
  1. Windows
I have a sheet which a user selected a risk from a drop down box. On pressing a run button I want the search for the value in B6 down, find any values of the same in a sheet called Database and copy the information to a different sheet. I have created the following code but it only copies the last line in the database for the relevant value in column B and not all copies of the data. If then also does not then look up the next search value in column B.

Any help will be appreciated.

Thank
VBA Code:
Sub RUN_Risk_Selection()

Sheets("Risk Assessment").Range("A2:AA10000").Clear
Call CDMRiskbatch1
Call CDMRiskbatch2

End Sub

Sub CDMRiskbatch1()

  Dim Bcell As Range
    Dim NextRow

'Surveying at height

        For Each Bcell In Sheets("Risk Selection").Range("B6", Sheets("Risk Selection").Range("B" & Rows.Count).End(xlUp))
            If Bcell.Value = "Surveying at Height" Then

                NextRow = Sheets("Risk Assessment").Range("A" & Rows.Count).End(xlUp).Row + 1
Sheets("Risk Assessment").Range("A" & NextRow) = Sheets("DataBase").Range("A" & Bcell.Row)
Sheets("Risk Assessment").Range("B" & NextRow) = Sheets("DataBase").Range("B" & Bcell.Row)
Sheets("Risk Assessment").Range("C" & NextRow) = Sheets("DataBase").Range("C" & Bcell.Row)
Sheets("Risk Assessment").Range("D" & NextRow) = Sheets("DataBase").Range("D" & Bcell.Row)
Sheets("Risk Assessment").Range("E" & NextRow) = Sheets("DataBase").Range("E" & Bcell.Row)
Sheets("Risk Assessment").Range("F" & NextRow) = Sheets("DataBase").Range("F" & Bcell.Row)
Sheets("Risk Assessment").Range("G" & NextRow) = Sheets("DataBase").Range("G" & Bcell.Row)
Sheets("Risk Assessment").Range("H" & NextRow) = Sheets("DataBase").Range("H" & Bcell.Row)
Sheets("Risk Assessment").Range("I" & NextRow) = Sheets("DataBase").Range("I" & Bcell.Row)
Sheets("Risk Assessment").Range("J" & NextRow) = Sheets("DataBase").Range("J" & Bcell.Row)
Sheets("Risk Assessment").Range("K" & NextRow) = Sheets("DataBase").Range("K" & Bcell.Row)
Sheets("Risk Assessment").Range("L" & NextRow) = Sheets("DataBase").Range("L" & Bcell.Row)
Sheets("Risk Assessment").Range("M" & NextRow) = Sheets("DataBase").Range("M" & Bcell.Row)
Sheets("Risk Assessment").Range("N" & NextRow) = Sheets("DataBase").Range("N" & Bcell.Row)
Sheets("Risk Assessment").Range("O" & NextRow) = Sheets("DataBase").Range("O" & Bcell.Row)
Sheets("Risk Assessment").Range("P" & NextRow) = Sheets("DataBase").Range("P" & Bcell.Row)
' Sheets("Risk Assessment").Range("Q" & NextRow) = Sheets("DataBase").Range("Q" & Bcell.Row)
' Sheets("Risk Assessment").Range("R" & NextRow) = Sheets("DataBase").Range("R" & Bcell.Row)
' Sheets("Risk Assessment").Range("S" & NextRow) = Sheets("DataBase").Range("S" & Bcell.Row)
' Sheets("Risk Assessment").Range("T" & NextRow) = Sheets("DataBase").Range("T" & Bcell.Row)
' Sheets("Risk Assessment").Range("U" & NextRow) = Sheets("DataBase").Range("U" & Bcell.Row)
' Sheets("Risk Assessment").Range("V" & NextRow) = Sheets("DataBase").Range("V" & Bcell.Row)
' ' Call formatting_dates
End If
Next Bcell
End Sub

Sub CDMRiskbatch2()

  Dim Bcell As Range
Dim NextRow
'Surveying unstable buildings/sites

        For Each Bcell In Sheets("Risk Selection").Range("B6", Sheets("Risk Selection").Range("B" & Rows.Count).End(xlUp))
            If Bcell.Value = "Surveying unstable buildings/sites" Then

                NextRow = Sheets("Risk Assessment").Range("A" & Rows.Count).End(xlUp).Row + 1
Sheets("Risk Assessment").Range("A" & NextRow) = Sheets("DataBase").Range("A" & Bcell.Row)
Sheets("Risk Assessment").Range("B" & NextRow) = Sheets("DataBase").Range("B" & Bcell.Row)
Sheets("Risk Assessment").Range("C" & NextRow) = Sheets("DataBase").Range("C" & Bcell.Row)
Sheets("Risk Assessment").Range("D" & NextRow) = Sheets("DataBase").Range("D" & Bcell.Row)
Sheets("Risk Assessment").Range("E" & NextRow) = Sheets("DataBase").Range("E" & Bcell.Row)
Sheets("Risk Assessment").Range("F" & NextRow) = Sheets("DataBase").Range("F" & Bcell.Row)
Sheets("Risk Assessment").Range("G" & NextRow) = Sheets("DataBase").Range("G" & Bcell.Row)
Sheets("Risk Assessment").Range("H" & NextRow) = Sheets("DataBase").Range("H" & Bcell.Row)
Sheets("Risk Assessment").Range("I" & NextRow) = Sheets("DataBase").Range("I" & Bcell.Row)
Sheets("Risk Assessment").Range("J" & NextRow) = Sheets("DataBase").Range("J" & Bcell.Row)
Sheets("Risk Assessment").Range("K" & NextRow) = Sheets("DataBase").Range("K" & Bcell.Row)
Sheets("Risk Assessment").Range("L" & NextRow) = Sheets("DataBase").Range("L" & Bcell.Row)
Sheets("Risk Assessment").Range("M" & NextRow) = Sheets("DataBase").Range("M" & Bcell.Row)
Sheets("Risk Assessment").Range("N" & NextRow) = Sheets("DataBase").Range("N" & Bcell.Row)
Sheets("Risk Assessment").Range("O" & NextRow) = Sheets("DataBase").Range("O" & Bcell.Row)
Sheets("Risk Assessment").Range("P" & NextRow) = Sheets("DataBase").Range("P" & Bcell.Row)
' Sheets("Risk Assessment").Range("Q" & NextRow) = Sheets("DataBase").Range("Q" & Bcell.Row)
' Sheets("Risk Assessment").Range("R" & NextRow) = Sheets("DataBase").Range("R" & Bcell.Row)
' Sheets("Risk Assessment").Range("S" & NextRow) = Sheets("DataBase").Range("S" & Bcell.Row)
' Sheets("Risk Assessment").Range("T" & NextRow) = Sheets("DataBase").Range("T" & Bcell.Row)
' Sheets("Risk Assessment").Range("U" & NextRow) = Sheets("DataBase").Range("U" & Bcell.Row)
' Sheets("Risk Assessment").Range("V" & NextRow) = Sheets("DataBase").Range("V" & Bcell.Row)
' ' Call formatting_dates
End If
Next Bcell
End Sub
 

Excel Facts

Workdays for a market open Mon, Wed, Friday?
Yes! Use "0101011" for the weekend argument in NETWORKDAYS.INTL or WORKDAY.INTL. The 7 digits start on Monday. 1 means it is a weekend.
Why are you looping through a sheet called "Risk Selection", but then pulling data from a different sheet?
That makes no sense to me. :unsure:
 
Upvote 0
Hi, The plan is to select that data required in "Risk Selection", it then searches "Database" and copies the matching values to "Risk Assessment"
 
Upvote 0
I'm sorry but still makes no sense to me, as you are not searching the "Database" sheet.
Should this line
VBA Code:
For Each Bcell In Sheets("Risk Selection").Range("B6", Sheets("Risk Selection").Range("B" & Rows.Count).End(xlUp))
be looking at the Database sheet?
 
Upvote 0
yes, it should select the search parameter from Risk Selection then search the database
 
Upvote 0
If you change the sheet name on that line from "Risk Selection" to "Database" does it do what you want?
If not, please describe exactly what you are trying to do.
 
Upvote 0
Hi Fluff, didn't work.

on the sheet "Risk Selection", users should user drop down boxes in Column B to select risk elements. Each risk element then has multiple risks in the "database".

On pressing the button I want the risk element in column b of "Risk Selection" be the search parameter in the "database". in finding any line with the same search element in "database" I want it to be copied and placed into a new Sheet "Risk Assessment" so it builds up a list of any items selected in the "Risk Assessment Sheet"
 
Upvote 0
Ok, which column in the Database sheet needs to be searched?
 
Upvote 0
Ok, how about
VBA Code:
Sub rsutton()
   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("B6", .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
 
Upvote 0

Forum statistics

Threads
1,213,531
Messages
6,114,172
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top