VBA: Search for a value down a column, then across entire row, and then offset. Then copy and paste found values onto different sheet

blonde

New Member
Joined
Feb 12, 2018
Messages
28
Hi,

I have a reference sheet called 'Hosts List' which has one row per host. It contains lots of term dates which are grouped by academic year. There are six columns of term dates per academic year which go across the sheet, with multiple academic years. At the start of each group of date columns there is another column containing the academic year. Another sheet, ws, needs to reference this sheet and obtain the correct term start and end dates (two different values) according to the academic year and host name. The trigger for this is a column in sheet ws containing the length_type. When the length_type value is selected from a drop down list in this column, this should trigger a search in the 'Hosts List' sheet, and then copy and paste two term date values into the relevant two cells on the same row in sheet ws, offset from the value in the length_type column.

I don't know how to get this working correctly as it involves two different finds, the first looks down a specific column (host_name) but the second (acad_year2) needs to look across the entire row of the matched host_name. Once the correct match is found on these two values, along the row where the acad_year2 value is matched on the academic year, it then needs to offset from the found cell according to the value in length_type, copying and pasting values from two offset cells into sheet ws.

I'd appreciate any help to get this working please.

Here is my code:

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
 
Dim fnd2 as Range
Dim length_type as string
Dim acad_year2 as string
Dim acad_year3 as string
Dim host_name as string
Dim ws as Worksheet


Set ws = ThisWorkbook.Sheets("Students Overseas")

If Target.CountLarge > 1 Then Exit Sub

Application.EnableEvents = False


If Not Intersect(Target, Range("AL7:AL5000")) Is Nothing Then

length_type = Target.Value

Target.Offset(0, -23).Value = host_name

Target.Offset(0, -27).Value = acad_year2

Set fnd2 = Sheets("Hosts List").Range("B3:B2000").Find(host_name, , , xlWhole, , , False, , False)

If Not fnd2 Is Nothing Then

Set acad_year3 = Rows(fnd2).Find(what:=acad_year2, LookIn:=xlValues, lookat:=xlWhole)

 
If length_type = "All year" then
    acad_year3.offset(, 1).Copy
    'then paste back into ws into column Z on target row, (or offsetting Target.Value by -12)
    ws.Range(target.row, 26).PasteSpecial xlPasteValues
    
    acad_year3.offset(, 6).Copy
    'then paste back into ws into column AA on target row, (or offsetting Target.Value by -11)
    ws.Range(target.row, 27).PasteSpecial xlPasteValues

If length_type = "Autumn term only" then
    acad_year3.offset(, 1).Copy
    'then paste back into ws into column Z on target row, (or offsetting Target.Value by -12)
    ws.Range(target.row, 26).PasteSpecial xlPasteValues

    acad_year3.offset(, 2).Copy
    'then paste back into ws into column AA on target row, (or offsetting Target.Value by -11)
    ws.Range(target.row, 27).PasteSpecial xlPasteValues

If length_type = "Autumn & Spring terms" then
    acad_year3.offset(, 1).Copy
    'then paste back into ws into column Z on target row, (or offsetting Target.Value by -12)
    ws.Range(target.row, 26).PasteSpecial xlPasteValues

    acad_year3.offset(, 4).Copy
    'then paste back into ws into column AA on target row, (or offsetting Target.Value by -11)
    ws.Range(target.row, 27).PasteSpecial xlPasteValues

If length_type = "Spring term only" then
    acad_year3.offset(, 3).Copy
    'then paste back into ws into column Z on target row, (or offsetting Target.Value by -12)
    ws.Range(target.row, 26).PasteSpecial xlPasteValues

    acad_year3.offset(, 4).Copy
    'then paste back into ws into column AA on target row, (or offsetting Target.Value by -11)
    ws.Range(target.row, 27).PasteSpecial xlPasteValues

If length_type = "Spring & Summer terms" then
    acad_year3.offset(, 3).Copy
    'then paste back into ws into column Z on target row, (or offsetting Target.Value by -12)
    ws.Range(target.row, 26).PasteSpecial xlPasteValues

    acad_year3.offset(, 6).Copy
    'then paste back into ws into column AA on target row, (or offsetting Target.Value by -11)
    ws.Range(target.row, 27).PasteSpecial xlPasteValues

If length_type = "Summer term only" then
    acad_year3.offset(, 5).Copy
    'then paste back into ws into column Z on target row, (or offsetting Target.Value by -12)
    ws.Range(target.row, 26).PasteSpecial xlPasteValues

    term_end_date = acad_year3.offset(, 6).value
    'then paste back into ws into column AA on target row, (or offsetting Target.Value by -11)
    ws.Range(target.row, 27).PasteSpecial xlPasteValues

end if
end if
end if
end if
end if
end if

end if
end if


Application.EnableEvents = True

end sub
 

Excel Facts

Test for Multiple Conditions in IF?
Use AND(test, test, test, test) or OR(test, test, test, ...) as the logical_test argument of IF.

Forum statistics

Threads
1,223,248
Messages
6,171,027
Members
452,374
Latest member
keccles

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