Hi I am looking to alter code from Vcoolio the following post:
Find string match in column then paste adjacent cell
Here are the steps I am looking to execute:
- Look for change in cell value in Sheet5 cell $V$1 (there is a dropdown in this with two options) - at this stage I have attempted make this work via a Worksheet Change
- Look for first instance of the String "Test Column" in Column A.
- If value of $V$1 is "Big_Column" (without quotes), Select named range "Big_Column" expand the selection by two additional rows - then copy, OR if value of $V$1 is "Small_Column" (without quotes), Select named range "Small_Column" expand the selection by two additional rows - then copy
- Paste expanded selection 1 row down and 7 columns to the right of the 'found' string.
- Look for next instance of "Test Column" in Column A, then repeat steps 2 and 3, till all found, then end.
Any help to get this code working would be much appreciated.
Thanks
Here is my edited code. I have only attempted to paste one of the ranges in this code but would like to do both. It could be done with two separate macros if this is cleaner, activated by the worksheet change macro.
Code
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$V$1" Then
Call PasteFlows
End If
End Sub
_______________________________
Sub PasteFlows()
Application.ScreenUpdating = False
Dim lRow As Long
Dim fValue As String
lRow = Sheet1.Range("A" & Rows.Count).End(xlUp).Row
For Each cell In Sheet1.Range("A1:A" & lRow)
fValue = "Test Column"
If cell.Offset(0, 1).Value = fValue Then
Range("Big_Column").Select
Selection.Resize(Selection.Rows.Count + 2, _
Selection.Columns.Count).Select
Selection.Copy
cell.Offset(1, 7).PasteSpecial xlPasteValues
End If
NextCell:
Next cell
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
Display More