Opv
04-03-2012, 10:52 AM
I have created the following snipped to keep a CSV version of my contact list updated as changes are made to the XLS file. I'm planning to implement the code either using a Worksheet_Change (unless there is a better alternative for Excel 2000) after I get it working properly.
Sub testCVS()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim wbk As Workbook
Dim cel, rng As Range
Set wbk = Workbooks.Add
Workbooks("CONTACTS.xls").Sheets("MyContacts").Copy wbk.Sheets(1)
With wbk
.Sheets(1).Name = "MyContacts"
.Sheets(2).Delete
.Sheets(3).Delete
.Sheets(2).Delete
.Sheets("MyContacts").AutoFilterMode = False
Set rng = .Sheets("MyContacts").Range("A1", .Sheets("MyContacts").Range("A1").End(xlToRight)) 'IN NEW WORKBOOK
For Each cel In rng
If cel.Value = "FirstName" Or _
cel.Value = "LastName" Or _
cel.Value = "Email1" Or _
cel.Value = "Notes" Then
cel.Offset(0, 1).Select
Else: cel.EntireColumn.Delete
End If
Next
End With
'wbk.SaveAs FileName:="C:\Users\Opv\My Documents\Contacts.csv", _
' FileFormat:=xlCSV, CreateBackup:=False
'wbk.Close
Application.ScreenUpdating = True
End Sub
Since my contact database is rather extensive and complex, what I'm wanting is to accomplish after the new workbook is created is delete all blank worksheets, then delete all columns in the new workbook except those identified before saving the new workbook as a CSV file. For some reason, my FOR loop is not deleting the superfluous columns. Also, if there is an easier way to accomplish this, I'm open to suggestions. Thanks, Opv.
Sub testCVS()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim wbk As Workbook
Dim cel, rng As Range
Set wbk = Workbooks.Add
Workbooks("CONTACTS.xls").Sheets("MyContacts").Copy wbk.Sheets(1)
With wbk
.Sheets(1).Name = "MyContacts"
.Sheets(2).Delete
.Sheets(3).Delete
.Sheets(2).Delete
.Sheets("MyContacts").AutoFilterMode = False
Set rng = .Sheets("MyContacts").Range("A1", .Sheets("MyContacts").Range("A1").End(xlToRight)) 'IN NEW WORKBOOK
For Each cel In rng
If cel.Value = "FirstName" Or _
cel.Value = "LastName" Or _
cel.Value = "Email1" Or _
cel.Value = "Notes" Then
cel.Offset(0, 1).Select
Else: cel.EntireColumn.Delete
End If
Next
End With
'wbk.SaveAs FileName:="C:\Users\Opv\My Documents\Contacts.csv", _
' FileFormat:=xlCSV, CreateBackup:=False
'wbk.Close
Application.ScreenUpdating = True
End Sub
Since my contact database is rather extensive and complex, what I'm wanting is to accomplish after the new workbook is created is delete all blank worksheets, then delete all columns in the new workbook except those identified before saving the new workbook as a CSV file. For some reason, my FOR loop is not deleting the superfluous columns. Also, if there is an easier way to accomplish this, I'm open to suggestions. Thanks, Opv.