Hello people
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?
TVM
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
'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
Display More