Search and Copy Code not Working

[ExcelGirl1988]

Hi, I am trying to sort out my search function in VBA where dates are put in on a worksheet and the code will search for data between the two dates and then copy this data and paste it to another worksheet. This doesn't seem to work though and I am not advanced enough in my VBA code to work it out, can anyone help?

Sub CopyDataBasedonDate()
Dim DbExtract As Variant
Dim Search As Variant


'Disabling screen updates
Application.ScreenUpdating = False


'Declaring two variables of Date data type
Dim StartDate, EndDate As Date
StartDate = Format(CDate(StartDate), "dd/mm/yyyy")
EndDate = Format(CDate(EndDate), "dd/mm/yyyy")


'Declaring variable for worksheet object
Dim MainWorksheet As Worksheet


'Initializing the Date variables with starting date from cell J8
'and end date from cell J9 of "Macro" sheet
StartDate = Sheets("Home").Range("D3").Value
EndDate = Sheets("Home").Range("D4").Value


'Initializing worksheet object with "RawData" worksheet
Set MainWorksheet = Worksheets("Test1")


'Activating the worksheet object
MainWorksheet.Activate


'Sorting the data by date in column B in ascending order
Range("B3").CurrentRegion.Sort _
      key1:=Range("A:C"), order1:=xlAscending, _
       Header:=xlYes


'Filter the data based on date range between starting date and end date
 Search = ActiveSheet.ListObjects("Table1").Range.Autofilter(Field:=2, Operator:= _
        xlFilterValues, Criteria1:=">=" & StartDate, Operator:=xlAnd, Criteria2:="<=" & EndDate)
        
'Copy the filter data
 MainWorksheet.ListObjects("Table1").Range.Copy


'Pasting the copied data
Selection.Copy
Sheets("Summary").Select
ActiveSheet.Paste


'Auto adjusting the size of selected columns
Selection.Columns.AutoFit


Range("A1").Select


'Removing filter from the worksheet which we applied earlier
If MainWorksheet.AutoFilterMode Then ActiveSheet.ShowAllData


Sheets("Home").Activate


End Sub

 

[RCBricker]

Hi, I am trying to sort out my search function in VBA where dates are put in on a worksheet and the code will search for data between the two dates and then copy this data and paste it to another worksheet. This doesn't seem to work though and I am not advanced enough in my VBA code to work it out, can anyone help?

Sub CopyDataBasedonDate()
Dim DbExtract As Variant
Dim Search As Variant


'Disabling screen updates
Application.ScreenUpdating = False


'Declaring two variables of Date data type
Dim StartDate, EndDate As Date
StartDate = Format(CDate(StartDate), "dd/mm/yyyy")
EndDate = Format(CDate(EndDate), "dd/mm/yyyy")


'Declaring variable for worksheet object
Dim MainWorksheet As Worksheet


'Initializing the Date variables with starting date from cell J8
'and end date from cell J9 of "Macro" sheet
StartDate = Sheets("Home").Range("D3").Value
EndDate = Sheets("Home").Range("D4").Value


'Initializing worksheet object with "RawData" worksheet
Set MainWorksheet = Worksheets("Test1")


'Activating the worksheet object
MainWorksheet.Activate


'Sorting the data by date in column B in ascending order
Range("B3").CurrentRegion.Sort _
      key1:=Range("A:C"), order1:=xlAscending, _
       Header:=xlYes


'Filter the data based on date range between starting date and end date
 Search = ActiveSheet.ListObjects("Table1").Range.Autofilter(Field:=2, Operator:= _
        xlFilterValues, Criteria1:=">=" & StartDate, Operator:=xlAnd, Criteria2:="<=" & EndDate)
        
'Copy the filter data
 MainWorksheet.ListObjects("Table1").Range.Copy


'Pasting the copied data
Selection.Copy
Sheets("Summary").Select
ActiveSheet.Paste


'Auto adjusting the size of selected columns
Selection.Columns.AutoFit


Range("A1").Select


'Removing filter from the worksheet which we applied earlier
If MainWorksheet.AutoFilterMode Then ActiveSheet.ShowAllData


Sheets("Home").Activate


End Sub

Here is your code, I changed the date variables to string variables. This works with dummy data.

Sub CopyDataBasedonDate() 'excelgirl1988
Dim DbExtract As Variant
Dim Search As Variant


'Disabling screen updates
Application.ScreenUpdating = False


'Declaring two variables of Date data type
'Dim StartDate As Date, EndDate As Date
'StartDate = Format(CDate(StartDate), "dd/mm/yyyy")
'EndDate = Format(CDate(EndDate), "dd/mm/yyyy")


'Declaring variable for worksheet object
Dim MainWorksheet As Worksheet


'Initializing the Date variables with starting date from cell J8
'and end date from cell J9 of "Macro" sheet
'StartDate = Sheets("Home").Range("D3").Value
'EndDate = Sheets("Home").Range("D4").Value


Dim strST As String, strEND As String
strST = Sheets("Home").Range("D3").Value
strEND = Sheets("Home").Range("D4").Value

'Initializing worksheet object with "RawData" worksheet
Set MainWorksheet = Worksheets("Test1")


'Activating the worksheet object
MainWorksheet.Activate


'Sorting the data by date in column B in ascending order
Range("B3").CurrentRegion.Sort _
      key1:=Range("A:C"), order1:=xlAscending, _
       Header:=xlYes

''Filter the data based on date range between starting date and end date
' Search = ActiveSheet.ListObjects("Table1").Range.AutoFilter(Field:=2, Operator:= _
'        xlFilterValues, Criteria1:=">=" & StartDate, Operator:=xlAnd, Criteria2:="<=" & EndDate)
'
'
        
'Filter the data based on date range between starting date and end date
 Search = ActiveSheet.ListObjects("Table1").Range.AutoFilter(Field:=2, Operator:= _
        xlFilterValues, Criteria1:=">=" & strST, Operator:=xlAnd, Criteria2:="<=" & strEND)
        
        
        
'Copy the filter data
 MainWorksheet.ListObjects("Table1").Range.Copy


'Pasting the copied data
Selection.Copy
Sheets("Summary").Select
ActiveSheet.Paste


'Auto adjusting the size of selected columns
Selection.Columns.AutoFit


Range("A1").Select


'Removing filter from the worksheet which we applied earlier
If MainWorksheet.AutoFilterMode Then ActiveSheet.ShowAllData


Sheets("Home").Activate


End Sub

 

[kashif.special2005]

Hi ExcelGirl1988,

I am using AdvancedFilter technique for filtering the data.

Let say you have data in column A and B with heading A1="Date" and B1="Name", now put the value in F1="Date" and G1="Date" and F2 write formula =">="&TEXT("5/8/2018","mm/dd/yyyy") and in G2 formula ="<="&TEXT("10/8/2018","mm/dd/yyyy").

Note:- In F2 the value will be "Start Date" and in G2 the value will be "End Date"

now in I1 put column heading "Date" and in in J1 put column heading "Name", and then finally run below code.

Note:- You can put column's heading from you data, which values you want to extract, the COLUMNS HEADINGS NAME WILL THE EXACT SAME.

Sub FilterData()


    Dim rngData As Range
    Dim rngCriteria As Range
    Dim rngCopy As Range


    Set rngData = Sheet3.Range("A1").CurrentRegion
    Set rngCriteria = Sheet3.Range(Sheet3.Cells(1, "F"), Sheet3.Cells(2, "G"))
    Set rngCopy = Sheet3.Range(Sheet3.Cells(1, "I"), Sheet3.Cells(1, "J"))




    '   Delete hidden names
        On Error Resume Next
        With ActiveWorkbook
          .Names("_FilterDatabase").Delete
          .Names("Criteria").Delete
          .Names("Extract").Delete
        End With
        On Error GoTo 0
        
    'Applying Advanced filter
    rngData.AdvancedFilter Action:=xlFilterCopy, _
                            criteriarange:=rngCriteria, _
                            copytorange:=rngCopy, _
                            unique:=False


End Sub

I hope this will help you.

Thanks
Kashif

 

[ExcelGirl1988]

Hi, thank you for your replies, I will try your suggestions.

 

[ExcelGirl1988]

Hi, I have tried these suggestions and they have not worked. The code basically needs to search between two dates that are input by the user and the code will then search all the worksheets to find the dates and it will copy the row of data associated with each date and copy these into the summary tab and the code will run through each worksheet until all correct dates have been found and the data has been copied. I am quite new to VBA and have been working on this code for a while and I don't seem to be able to get it to work properly, does anyone have any suggestions?

Thank you

 

[RCBricker]

Hi, I have tried these suggestions and they have not worked. The code basically needs to search between two dates that are input by the user and the code will then search all the worksheets to find the dates and it will copy the row of data associated with each date and copy these into the summary tab and the code will run through each worksheet until all correct dates have been found and the data has been copied. I am quite new to VBA and have been working on this code for a while and I don't seem to be able to get it to work properly, does anyone have any suggestions?

Thank you

What have they not done? Have you used F to move through the code line by line to see where it is not performing as you intend? What about variables? Are you using the immediate window to see what they are caring to ensure they have captured the correct data? I want to help, but just saying it does not work limits my ability to determine what is wrong. The code I provided, filtered a table of data based on dates in the dd/mm/yyyy format. then copied those line to a new worksheet.

 

[kashif.special2005]

Hi,

Are the columns name in all the worksheet are the same?

Thanks kashif

 

[RCBricker]

try this code. Then we can expand it to multiple worksheets

Sub CopyDataBasedonDate() 'excelgirl1988
Dim wb As Workbook
Dim wsTBL As Worksheet, wsSUM As Worksheet, ws As Worksheet, wsHOME As Worksheet
Dim lngROW As Long, lngCOL As Long
Dim rng As Range, cell As Range, rngHEAD As Range, rngUSED As Range
Dim dST As Date, dEND As Date
Dim strST As String, strEND As String
Dim varI As Variant, row As Variant


Dim DbExtract As Variant
Dim Search As Variant

'***********************************************************************************
'       Application parameters removed to increase code speed
'***********************************************************************************
With Application
    .DisplayAlerts = False
    .Calculation = xlCalculationManual
    '.ScreenUpdating = False
.ScreenUpdating = True
    .EnableEvents = False
End With

Set wb = ThisWorkbook
Set wsTBL = wb.Sheets("Test1")  'Change this to your sheet name with your data
Set wsSUM = wb.Sheets("Summary")  'Change this to your sheet name with your summary
Debug.Print wsSUM.Name
Set wsHOME = wb.Sheets("Home")

'***********************************************************************************
'       apply date formatting to the data pulled from the worksheet
'***********************************************************************************
'dST = Format(CDate(wsHOME.Cells(3, 4)), "dd/mm/yyyy")
'dEND = Format(CDate(wsHOME.Cells(4, 4)), "dd/mm/yyyy")

'***********************************************************************************
'       populate date information as a string variable.
'***********************************************************************************
strST = Format(wsHOME.Cells(3, 4), "dd/mm/yyyy")
strEND = Format(wsHOME.Cells(4, 4), "dd/mm/yyyy")
wsTBL.Select
With wsTBL

'***********************************************************************************
'       Sort the table data
'***********************************************************************************
    wsTBL.Range("Table1").Select
    wsTBL.ListObjects("Table1").Sort.SortFields.Clear
    wsTBL.ListObjects("Table1").Sort.SortFields.Add _
        Key:=Range("Table1[Field2]"), SortOn:=xlSortOnValues, Order:=xlAscending _
        , DataOption:=xlSortNormal
    With wsTBL.ListObjects("Table1").Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
 'Filter the data based on date range between starting date and end date
' Search = ActiveSheet.ListObjects("Table1").Range.AutoFilter(Field:=2, Operator:= _
'        xlFilterValues, Criteria1:=">=" & CStr(dST), Operator:=xlAnd, Criteria2:="<=" & CStr(dEND))
        
 'Filter the data based on date range between starting date and end date
 Search = wsTBL.ListObjects("Table1").Range.AutoFilter(Field:=2, Operator:= _
        xlFilterValues, Criteria1:=">=" & strST, Operator:=xlAnd, Criteria2:="<=" & strEND)
        
'Copy the filter data
For Each row In Range("Table1[#All]").Rows
    If row.EntireRow.Hidden = False Then
        If rng Is Nothing Then Set rng = row
        Set rng = Union(row, rng)
    End If
Next row



    wsSUM.Select
    With wsSUM
        lngROW = wsSUM.Range("A" & .Rows.Count).End(xlUp).row
    rng.Copy
    wsSUM.Cells(lngROW + 1, 1).PasteSpecial xlPasteAll
    End With
End With

'Auto adjusting the size of selected columns
wsSUM.Columns.AutoFit
Range("A1").Select

'Removing filter from the worksheet which we applied earlier
If wsTBL.AutoFilterMode Then ActiveSheet.ShowAllData
Sheets("Home").Activate

With Application
    .DisplayAlerts = True
    .Calculation = xlCalculationAutomatic
    .ScreenUpdating = True
    .EnableEvents = True
End With

End Sub

 

[RCBricker]

Hi, I have tried these suggestions and they have not worked. The code basically needs to search between two dates that are input by the user and the code will then search all the worksheets to find the dates and it will copy the row of data associated with each date and copy these into the summary tab and the code will run through each worksheet until all correct dates have been found and the data has been copied. I am quite new to VBA and have been working on this code for a while and I don't seem to be able to get it to work properly, does anyone have any suggestions?

Thank you

ok this code will go to each sheet in the workbook and check each tbl in the worksheet, filter it and copy and paste it to the summary sheet

Sub CopyDataBasedonDate() 'excelgirl1988
Dim wb As Workbook
Dim wsTBL As Worksheet, wsSUM As Worksheet, ws As Worksheet, wsHOME As Worksheet
Dim lngROW As Long, lngCOL As Long
Dim rng As Range, cell As Range, rngHEAD As Range, rngUSED As Range
Dim dST As Date, dEND As Date
Dim strST As String, strEND As String, strTBL As String
Dim intCNT As Integer, intST As Integer
Dim varI As Variant, row As Variant, i As Variant
Dim Search As Variant

'***********************************************************************************
'       Application parameters removed to increase code speed
'***********************************************************************************
    With Application
        .DisplayAlerts = False
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
'.ScreenUpdating = True
        .EnableEvents = False
    End With
    Set wb = ThisWorkbook
    Set wsTBL = wb.Sheets("Test1")  'Change this to your sheet name with your data
    Set wsSUM = wb.Sheets("Summary")  'Change this to your sheet name with your summary
    Set wsHOME = wb.Sheets("Home")  'Change this to your home sheet
'***********************************************************************************
'       populate date information as a string variable.
'***********************************************************************************
    strST = Format(wsHOME.Cells(3, 4), "dd/mm/yyyy")
    strEND = Format(wsHOME.Cells(4, 4), "dd/mm/yyyy")
    For Each ws In wb.Worksheets
        For Each tbl In ws.ListObjects
            Set rng = Nothing
            strTBL = tbl.Name
            ws.Range(strTBL).Select
'***********************************************************************************
'       Sort the table data
'***********************************************************************************
            tbl.Sort.SortFields.Clear
            tbl.Sort.SortFields.Add _
                Key:=Range(strTBL & "[Field2]"), _
                SortOn:=xlSortOnValues, _
                Order:=xlAscending, _
                DataOption:=xlSortNormal
            With tbl.Sort
                .Header = xlYes
                .MatchCase = False
                .Orientation = xlTopToBottom
                .SortMethod = xlPinYin
                .Apply
            End With
'***********************************************************************************
'       Filter the data based on date range between starting date and end date
'***********************************************************************************
            Search = ws.ListObjects(strTBL).Range.AutoFilter(Field:=2, _
                            Operator:=xlFilterValues, _
                            Criteria1:=">=" & strST, _
                            Operator:=xlAnd, _
                            Criteria2:="<=" & strEND)
'***********************************************************************************
'       Prepare the table data for copying only the filtered data
'***********************************************************************************
            For Each row In tbl.DataBodyRange.Rows
                If row.EntireRow.Hidden = False Then
                    If rng Is Nothing Then Set rng = row
                    Set rng = Union(row, rng)
                End If
            Next row
        Next tbl
'***********************************************************************************
'       Paste the data in the next avaialble row of the summary sheet
'***********************************************************************************
        wsSUM.Select
        With wsSUM
            lngROW = wsSUM.Range("A" & .Rows.Count).End(xlUp).row
            rng.Copy
            wsSUM.Cells(lngROW + 1, 1).PasteSpecial xlPasteAll
        End With
'***********************************************************************************
'       Removing filter from the table which we applied earlier
'***********************************************************************************
        If ws.AutoFilterMode Then ActiveSheet.ShowAllData
    Next ws
'***********************************************************************************
'       Autofit columns to summary table
'***********************************************************************************
    wsSUM.Select
    wsSUM.Columns.AutoFit
'***********************************************************************************
'       Return to the home worksheet
'***********************************************************************************
    Sheets("Home").Activate
'***********************************************************************************
'       Application parameters returned to their proper settings
'***********************************************************************************
    With Application
        .DisplayAlerts = True
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub