As a continuation of my previous road to enlightenment project ie learn some useful VBA, I requested help to select rows of data that contained the current month and export those rows and selected columns into a CSV ready to be exported into another program. Thanks to everyone who provided advice or updated my code.
My issue now is how to select any month within a calendar year rather than just the current month. I was thinking of a drop down menu where you can select a month but unfortunately I have no idea how to implement this into my current code. ( I saw something similar elsewhere but unfortunately I couldn't make it work for me so binned it).
Anyone out there who can set me in the right direction?
Many thanks once again.
Also, on another note (apologies to admin if 2nd question is not allowed under the same heading), I export the headers separately as I believe that they are not copied over due to to not being recognised as a date in the error capture routine.
When the relevant date rows are then copied to the new sheet, I end up with a blank rows between the headers and the data.
I know I could just delete the blank rows but was wondering if there was a more elegant way to move the data up so it sits below the the headers?
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 'Copy Headers wsOld.Range("C1:D1").Copy wsNew.Range("A1:B1") wsOld.Range("F1:G1").Copy wsNew.Range("C1:D1") wsOld.Range("H1:H1").Copy wsNew.Range("E1:E1") wsOld.Range("K1:K1").Copy wsNew.Range("F1:F1") wsOld.Range("O1:P1").Copy wsNew.Range("G1:H1") 'Copy relevant rows and columns 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()) 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 'Save as CSV 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