VBA autofilter

i_malc

New Member
Joined
Aug 28, 2010
Messages
14
Can anyone help me please. I fairly new to VBA
I have a spreadsheet that I want to filter between dates on column E.
The date is in text format and in reverse order eg 19991003. Ive got some code written but when I run it it changes " =DATE(LEFT(AO2,4),MID(AO2,5,2),RIGHT(AO2,2))" and it puts an inverted comers either side of the cell " =DATE('AO2',4),MID('AO2',5,2)RIGHT('AO2',2)).

Is there a more straight forward way I can do this?

MY CODE IS AS FOLLOWS

Private Sub CommandButton1_Click()


Dim report, import, export As Workbook
Dim extract, dups As Worksheet
Dim lastrow As Long
Dim StDate As Date
Dim EndDate As Date
Dim lstdate As Long
Dim lenddate As Long
Dim wbname As String
Dim ssave, esave As String




StDate = InputBox("Please enter the start date")
EndDate = InputBox("please enter the end date")
wbname = "VAT report "
'ssave = StDate.NumberFormat("dd-mm-yyyy")
'esave = EndDate.NumberFormat("dd-mm-yyyy")








Set report = ActiveWorkbook
Set import = Workbooks.Open("C:\Users\Laptop\Desktop\test2.xls") 'CHANGE THE PATH AND NAME OF WHERE THE SOURCE IS HERE


import.Sheets("sheet1").Range("E1").Select 'Go to first cell of column that needs reformatting
ActiveSheet.Range(Selection, Selection.End(xlDown)).Select 'Go to last used cell in this column and select all between
Selection.Copy 'Copy selected cells
import.Sheets("sheet1").Range("AO1").Select 'Go to an empty column on sheet
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False 'Paste copied cells
ActiveSheet.Range(Selection, Selection.End(xlDown)).Select 'Go to last used cell in pasted column
With ActiveSheet
lastrow = .Cells(.Rows.Count, "AO").End(xlUp).Row 'Set "lastrow to equal last cell up to first cell counts no of cells to change format
Debug.Print lastrow 'shows in the immediate window how many cells have been counted
End With
import.Sheets("sheet1").Range("AP2").Select 'select ap2
Columns("AP:AP").Select
Selection.NumberFormat = "dd/mm/yyyy"
ActiveCell.FormulaR1C1 = "=DATE(LEFT(AO2,4),MID(AO2,5,2),RIGHT(AO2,2))" 'puts in the formula = text to serial date
import.Sheets("sheet1").Range("AP2").Select 'Select cell
Selection.Copy 'Copy value in cell
import.Sheets("sheet1").Range("AP3:ap" & lastrow).Select 'copies the formula in ap2 down to all the cells in the column
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
import.Sheets("sheet1").Range("ap2").Select
ActiveSheet.Range(Selection, Selection.End(xlDown)).Select 'selects all cells in col ap
Selection.NumberFormat = "m/d/yyyy" 'changes them to a date format not a serial number

'this bit copies all the changes back to column E


import.Sheets("sheet1").Range("AP2").Select
ActiveSheet.Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
import.Sheets("sheet1").Range("E2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Selection.NumberFormat = "m/d/yyyy"
import.Sheets("sheet1").Range("ao1:ap" & lastrow).Select 'this just clears the formulas and tidies up the columns
Selection.Clear
import.Sheets("sheet1").Range("a1").Select


StDate = DateSerial(Year(StDate), Month(StDate), Day(StDate))
EndDate = DateSerial(Year(EndDate), Month(EndDate), Day(EndDate))

lstdate = StDate
lenddate = EndDate

ActiveSheet.Range("A1:AN38900").AutoFilter 5, ">=" & lstdate, xlAnd, "<=" & lenddate 'filter by dates


Set extract = import.Sheets("sheet1") ' set "extract" as contence of sheet1


Set dups = Workbooks.Add.Sheets("Sheet1") 'New workbook sheet1
extract.Range("a1:an38900").SpecialCells(xlCellTypeVisible).Copy 'Copy selected range ONLY STUFF THAT IS VISIBLE NOT UNFILTERED DATA
dups.Cells(1, 1).PasteSpecial 'Paste selected range into new wookbook sheet1
dups.SaveAs ("C:\Users\Laptop\Desktop") & wbname & lstdate & "-" & lenddate, FileFormat:=xlExcel8 'CHANGE THE FILE PATH OF WHERE YOU WANT TO SAVE HERE
dups.Activate 'select new workbook
ActiveWorkbook.Close savechanges = False
import.Activate
ActiveSheet.ShowAllData 'removes the filter
import.Close False 'closes without saving


MsgBox "Export finished"


End Sub
 

Excel Facts

Move date out one month or year
Use =EDATE(A2,1) for one month later. Use EDATE(A2,12) for one year later.
You are not using R1C1 format in the formula so drop the R1C1 from the statement:
Code:
ActiveCell.FormulaR1C1 =
To
Code:
ActiveCell.Formula =
 
Last edited:
Upvote 0

Forum statistics

Threads
1,214,815
Messages
6,121,715
Members
449,049
Latest member
THMarana

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