Hello again
Further to my recent post about exporting selected Excel columns to CSV which was very kindly resolved by gijsmo , I decided I wanted to build on that and export only those rows where the date contains the current month.
The idea is that as a monthly report, I don't have to mess about selecting dates etc... the code just looks for the current month in column C and selects those rows for export.
So I used lr and r to find how many rows of data there are and then count through them to see if the row contains an actual date and if so, if the date contains the current month. The idea is then to copy these rows and selected columns into a CSV file for importing to another program.
(original VBA columns selection which worked previously is remmed out).
Unfortunately, when I get to the save as CSV screen, nothing is copied over and I don't know why. I would expect to see rows 3,4,5,6 and 7 appear in the new CSV as their dates in column C fall in May (which as of today is the current month).
Anyone tell me where I've gone wrong... and point me in the right direction please?
Many thanks
Smudge
Sub ExportToCSV()
Dim wsOld As Worksheet
Dim wsNew As Worksheet
Dim vFile
Dim lr As Long, r As Long
Set wsOld = ActiveSheet
Set wsNew = Workbooks.Add(xlWorksheet).Sheets(1)
With wsOld
lr = .Cells(Rows.Count, "C").End(xlUp).Row
For r = lr To 2 Step -1
If IsDate(.Range("C" & r).Value) Then
If Month(.Range("C" & r).Value) = Month(Now()) And Year(.Range("C" & r).Value) = Year(Now()) - 1 Then
wsOld.Range("C" & r & ":D" & r).Copy wsNew.Range("A" & r & ":B" & r)
wsOld.Range("F" & r & ":G" & r).Copy wsNew.Range("C" & r & ":D" & r)
wsOld.Range("H" & r & ":H" & r).Copy wsNew.Range("E" & r & ":E" & r)
wsOld.Range("K" & r & ":K" & r).Copy wsNew.Range("F" & r & ":F" & r)
wsOld.Range("O" & r & ":P" & r).Copy wsNew.Range("G" & r & ":H" & r)
End If
End If
Next r
'wsOld.Range("C:D").Copy wsNew.Range("A:B")
'wsOld.Range("F:G").Copy wsNew.Range("C:D")
'wsOld.Range("H:H").Copy wsNew.Range("E:E")
'wsOld.Range("K:K").Copy wsNew.Range("F:F")
'wsOld.Range("O:P").Copy wsNew.Range("G:H")
vFile = Application.GetSaveAsFilename(FileFilter:="CSV files (*.csv),*.csv")
If TypeName(vFile) = "Boolean" Then Exit Sub 'cancelled
Application.DisplayAlerts = False
wsNew.SaveAs vFile, FileFormat:=xlCSV, Local:=True
Application.DisplayAlerts = True
wsNew.Parent.Close False
End With
End Sub