Vba code to retrieve an entire column from sheet1 if the value in a cell of sheet2 matches the value of a header in sheet1

Question

I'm trying to find vba code that will bring the contents of an entire column in "sheet1" to "sheet2" if the value in cell A1, matches one of the headers in "sheet1" below is what I have so far:

Sub searchdata()
Dim lastrow As Long, x As Long

lastcolumn = Sheets("Practice Associations").Cells(Columns.Count,.End(xlToRight)

For y = 1 To lastcolumn
If Sheets("Practice Associations").Cells(y, 1).Value = Sheets("Sheet2").Range("A1").Value Then
    Sheets("Sheet2").Range("A2:A1000").Value = Sheets("Sheet1").Column(x, 1).Value

Basically, I'm trying to build a dashboard that will pull a list of values if the value searched in a search box matches one of the headers in the table. Any help is appreciated! Thanks in advance.

Answer 1

Hi this code addresses your requirements as it copies the entire column and paste the values on the corresponding matching column in sheet2

Option Explicit

Sub test()

With Excel.Application
    .ScreenUpdating = False
End With

Dim last_col_one, last_col_two As Range
Dim sheet_headers As Range
Dim xl_header As Range
Dim target_headers As Range
Dim cell As Range

With ThisWorkbook.Sheets("Sheet2")
    Set last_col_one = .Cells(1, .Columns.Count).End(xlToLeft)
    Set sheet_headers = .Range(.Cells(1, 1), last_col_one)
End With

With ThisWorkbook.Sheets("Sheet1")
    Set last_col_two = .Cells(1, .Columns.Count).End(xlToLeft)
    Set target_headers = .Range(.Cells(1, 1), last_col_two)
End With

For Each xl_header In sheet_headers
    For Each cell In target_headers
        If cell.Value = xl_header.Value Then
            cell.EntireColumn.Copy
            xl_header.PasteSpecial xlPasteValues
        End If
    Next cell
Next xl_header

With Excel.Application
    .CutCopyMode = False
    .ScreenUpdating = True
End With

End Sub

Answer 2

This should work:

Sub Macro3()

myVal = Sheets("Sheet2").Cells(1, 1).Value

t = 1
Found = 0

Do Until Found = 1

If Sheets("Sheet1").Cells(1, t) = myVal Then
Sheets("Sheet1").Columns(t).Copy
Sheets("Sheet2").Cells(1, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues
Found = 1
End If
t = t + 1

Loop

End Sub