# Copy and Paste certain column data to new sheet.



## blackgolf (Dec 10, 2022)

Hi guys, please help me with VBA code.  I have a data sheet.  I have a Result sheet.  In Cell A1 of the result sheet I have a date (month and day only).  I want to look up this date in the data sheet column K.  Whenever the same date (month and day only) is found in Column K, starting from row 6 to last row, it must copy the value of Column B, C and F to Result sheet, column B,C and D starting from row 6.  Then next find until last row of data sheet.  So every time that the date in cell A1 of Result sheet is found in column K of Data sheet, it must copy the values of Column B, C and F and paste it in Column B, C and D of Result sheet starting at Row 6, or if there are previous data, starting from first empty row of Column B.  So if cell B6 is empty it must start pasting it in B6.  But if rows 6, 7, 8, 9 and 10 already has data from previous search, then the paste must start at B11, the first empty row.  Much appreciated, thanks Chris


----------



## jdellasala (Dec 10, 2022)

Please post a sample table using XL2BB.


----------



## blackgolf (Dec 10, 2022)

Hi guys, please help me with VBA code. I have a data sheet. I have a Result sheet. In Cell A1 of the result sheet I have a date (month and day only). I want to look up this date in the data sheet column K. Whenever the same date (month and day only) is found in Column K, starting from row 6 to last row, it must copy the value of Column B, C and F to Result sheet, column B,C and D starting from row 6. Then next find until last row of data sheet. So every time that the date in cell A1 of Result sheet is found in column K of Data sheet, it must copy the values of Column B, C and F and paste it in Column B, C and D of Result sheet starting at Row 6, or if there are previous data, starting from first empty row of Column B. So if cell B6 is empty it must start pasting it in B6. But if rows 6, 7, 8, 9 and 10 already has data from previous search, then the paste must start at B11, the first empty row. Much appreciated, thanks Chris


Book1BCDEFGHIJK5NameSurnameTelDOB6JohnFox21592424417 March7FredBarber21592879518 March8AllanPringle21587214519 March9PeterPax21558975417 March10IngridGreen21587965418 March11JuliaRobert21698458719 March12AllenGreen21598621419 MarchData Sheet


Book1ABCDEFG117 March2345NameSurnameTel NoSo the VBA Code must take date in cell A1 (17 March) find it in column K of Data Sheet.6Every one that is found , the value of Col B C anf F must be copied and paste in Col BCD in here.7891011121314151617181920Result Sheet


----------



## jdellasala (Dec 13, 2022)

This is the table I started with. It's unclear why there are so many empty columns (or why it starts at B5 for that matter!) so I left them out:
Book1GHIJ1NameSurnameTelDOB2JohnFox21592424403/17/20223FredBarber21592879503/18/20224AllanPringle21587214503/19/20225PeterPax21558975403/17/20226IngridGreen21587965403/18/20227JuliaRobert21698458703/19/20228AllenGreen21598621403/19/2022Sheet1
The date desired is in cell A1 which is the named range* TargetDate*. It is a real date with a year, but in this case the year doesn't matter.
The date is pulled into Power Query and the Month and Day determined:

```
let
    Source = Excel.CurrentWorkbook(){[Name="TargetDate"]}[Content],
    ChangedType = Table.TransformColumnTypes(Source,{{"Column1", type date}}),
    InsertedMonth = Table.AddColumn(ChangedType, "Month", each Date.Month([Column1]), Int64.Type),
    InsertedDay = Table.AddColumn(InsertedMonth, "Day", each Date.Day([Column1]), Int64.Type)
in
    InsertedDay
```
And the Table named* tblData* is pulled into Power Query and filtered as needed:

```
let
    Source = Excel.CurrentWorkbook(){[Name="tblData"]}[Content],
    ChangedType0 = Table.TransformColumnTypes(Source,{{"Name", type text}, {"Surname", type text}, {"Tel", Int64.Type}, {"DOB", type date}}),
    AddedFilteredDOB = Table.AddColumn(ChangedType0, "DOB Keep", each if Date.Month([DOB]) = TargetDate[Month]{0} and Date.Day([DOB]) = TargetDate[Day]{0} then "KEEP" else null),
    FilteredNullRows = Table.SelectRows(AddedFilteredDOB, each ([DOB Keep] = "KEEP")),
    RemovedFilterColumn = Table.RemoveColumns(FilteredNullRows,{"DOB Keep"})
in
    RemovedFilterColumn
```
Which resulted in this table:
Book1BCDE5NameSurnameTelDOB6JohnFox21592424403/17/20227PeterPax21558975403/17/2022Sheet1
If you change the date in A1 and then right click on the Report table, it will update to report the date selected:
Book1ABCDE118-Mar2345NameSurnameTelDOB6FredBarber21592879503/18/20227IngridGreen21587965403/18/2022Sheet1
If you want to keep the data for a single report, just copy the entire table and *Paste Values* (just Paste will not only copy it as a table, but also make a copy of the query, and that won't be useful as a refresh will refresh to the new value in A1!


----------



## Fluff (Dec 13, 2022)

What version of Excel are you using?

I suggest that you update your Account details (or click your user name at the top right of the forum) so helpers always know what Excel version(s) & platform(s) you are using as the best solution often varies by version. (Don’t forget to scroll down & ‘Save’)


----------



## mmhill (Dec 14, 2022)

See the code below.  I made one assumption - the worksheet with the data can be used as a data table.  I think that's safe.

In the top of the MAIN CODE below, you will see data that you need to customize for your workbook ... worksheet names, data column headers, etc. Copy the MAIN CODE, paste into a VBA module and make the edits.  Then, in the VBA editor, click on the worksheet where you will enter the date and paste the WORKSHEET CODE there.

Whenever you change the date, the code will run and paste in the Name, Surname and phone number of everyone with that Month and Day of birth.

WORKSHEET CODE

```
Dim booRunChangeEvent As Boolean, booRunning As Boolean
Private Sub Worksheet_Change(ByVal Target As Range)
    If booRunning Then Exit Sub
    If booRunChangeEvent Then booRunning = True: Call FilterMagic2
    booRunning = False
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    booRunChangeEvent = Not Application.Intersect(ActiveCell, Range(cReadDateCellAddress)) Is Nothing
End Sub
```

MAIN CODE

```
Option Explicit

'edit these to fit your actual spreadsheet
'===============================================================================
Const cDataSheetName$ = "My Data"           'Name of Data worksheet
Const cName$ = "Name"                       'Data Column Header
Const cSurname$ = "Surname"                 'Data Column Header
Const cTel$ = "Tel"                         'Data Column Header

Const cResultSheetName$ = "My Results"      'Worksheet to paste resuts to
Public Const cReadDateCellAddress$ = "A1"   'Cell where date will be
Const cPasteAnchorAddress$ = "B6"           'Cell to start looking to paste data
'===============================================================================

Public Sub FilterMagic2()
Dim oWb As Workbook, iMonth%, iDay%
Dim dbConn As Object, strConn$  'http://www.connectionstrings.com
Dim strSQL$, dbRs As Object, rngOutputAnchor As Range
    
    Set oWb = ThisWorkbook '<< I ASSUME THIS WORKBOOK
    With oWb.Worksheets(cResultSheetName).Range(cReadDateCellAddress)
        iMonth = Month(.Value)
        iDay = Day(.Value)
    End With

    'Make this workbook a database
    Set dbConn = CreateObject("ADODB.Connection"): Set dbRs = CreateObject("ADODB.Recordset")
    strConn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source='" & oWb.FullName & "';Extended Properties='Excel 12.0 Macro;HDR=YES;IMEX=0';"
    dbConn.Open strConn

    'Base SQL string
    strSQL = "SELECT \Name\, \Surname\, \Tel\ FROM [\SheetName\$] WHERE MONTH(DOB)=\MONTH\ and DAY(DOB)=\DAY\;"
        strSQL = Replace(strSQL, "\Name\", cName, vbTextCompare)
        strSQL = Replace(strSQL, "\Surname\", cSurname, vbTextCompare)
        strSQL = Replace(strSQL, "\Tel\", cTel, vbTextCompare)
        strSQL = Replace(strSQL, "\SheetName\", cDataSheetName, vbTextCompare)
        strSQL = Replace(strSQL, "\MONTH\", iMonth, vbTextCompare)
        strSQL = Replace(strSQL, "\DAY\", iDay, vbTextCompare)

    'open record set
    dbRs.Open strSQL, strConn
    'oWb.Names(strTmpName).Delete
    
    'find open cell to push recordset to worksheet
    Set rngOutputAnchor = oWb.Worksheets(cResultSheetName).Range(cPasteAnchorAddress)
    Do While Len(rngOutputAnchor.Value) <> 0
        Set rngOutputAnchor = rngOutputAnchor.Offset(1)
    Loop
    rngOutputAnchor.CopyFromRecordset dbRs
    
CleanUp:

    dbRs.Close: Set dbRs = Nothing
    dbConn.Close: Set dbConn = Nothing
    Set rngOutputAnchor = Nothing
    Set oWb = Nothing
    
Exit Sub
    'OTHER SQL CONSTRUCTIONS
    'https://www.devhut.net/advanced-sql-to-connect-with-excel-workbooks/
    'strSQL = "SELECT * FROM DataTable where YEAR in (1927, 2000, 1885)" ''Named range
    'strSQL = "SELECT * FROM [Filter$A1:A100]" 'Range
    'strSQL = "SELECT * FROM [Sheet1$]" ''All the data in a sheet
    'strSQL = "SELECT * FROM [Excel 12.0 XML;HDR=YES;IMEX=1;database=C:\Docs\LTD.xlsx].[SHEETNAME$XX:XX]" ''Refer to second workbook
End Sub
```


----------



## blackgolf (Dec 14, 2022)

Thank you guys, going to start working on it now, will advice the outcome when done.


----------



## blackgolf (Dec 14, 2022)

Thank you mmhill for your code which I amended to contain my worksheet names etc.  The code is running fine (F8) until it must open record set.  Then i get the message below.  That is at line *dbRs.Open strSQL, strConn*
Will you please tell me what I must look out for that I missed in No Value given?

Also thanks to jdellasala for power query code.  As I know nothing about Power Queries I will first have to study the concept.
​


----------



## blackgolf (Dec 28, 2022)

Hi #mmhill, can you help me with the error I am getting please!


----------

