coserria
03-18-2008, 11:09 PM
Hello,
I have a series of dates all in my first Colum A:A, need to convert all of this column to a three letter date such as JAN, FEB, MAR and so on. Code would be the last part of this code, that I got help with. I'm totally lost as to how to make this end. Input date format is
17/11/2007 12:44:02
all I need is
NOV
Can any one show me how this would convert; I am having a lot of trouble finding where to get this. I used to have an insert function =text(a1,"MMM") that I would copy in an inserted column but now it will not give the correct out put. Formatting is not the issue and a bit of VB code would work better
On Error GoTo Exits:
For Each ws In Worksheets
With ws
.Activate
.Cells.MergeCells = False
.Cells.WrapText = False
.Range("A:B,D:E,K:U").Delete Shift:=xlToLeft
'Find and delete terms
For Each a In arr
.Cells.Replace What:=a, Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Next a
'rows and colums here down
Set rng = Range(ws.Columns(1), Columns(ws.Cells.SpecialCells(xlCellTypeLastCell).Column()))
For Col = rng.Columns.Count To 1 Step -1
If Application.WorksheetFunction.CountA(rng.Columns(Col).EntireColumn) = 0 Then
rng.Columns(Col).EntireColumn.Delete
End If
Next Col
Set rng = Range(ws.Rows(1), Rows(ws.Cells.SpecialCells(xlCellTypeLastCell).Row()))
For Rw = rng.Rows.Count To 1 Step -1
If Application.WorksheetFunction.CountA(rng.Rows(Rw).EntireRow) = 0 Then
rng.Rows(Rw).EntireRow.Delete
End If
Next Rw
'insert cell for alignment
.Range("B1,D1").Insert Shift:=xlDown
Set rng = Range(ws.Rows(1), Rows(ws.Cells.SpecialCells(xlCellTypeLastCell).Row()))
For Rw = rng.Rows.Count To 1 Step -1
If Application.WorksheetFunction.CountA(rng.Rows(Rw).EntireRow) = 0 Then
rng.Rows(Rw).EntireRow.Delete
End If
Next Rw
'.Range("A:A").Formatdatetime("dd/mm/YYYY hh:mm:ss", convert"MMM")
.Cells.Interior.ColorIndex = xlNone
.Cells.EntireColumn.AutoFit
.Cells.EntireRow.AutoFit
End With
Next ws
Exits:
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
I have a series of dates all in my first Colum A:A, need to convert all of this column to a three letter date such as JAN, FEB, MAR and so on. Code would be the last part of this code, that I got help with. I'm totally lost as to how to make this end. Input date format is
17/11/2007 12:44:02
all I need is
NOV
Can any one show me how this would convert; I am having a lot of trouble finding where to get this. I used to have an insert function =text(a1,"MMM") that I would copy in an inserted column but now it will not give the correct out put. Formatting is not the issue and a bit of VB code would work better
On Error GoTo Exits:
For Each ws In Worksheets
With ws
.Activate
.Cells.MergeCells = False
.Cells.WrapText = False
.Range("A:B,D:E,K:U").Delete Shift:=xlToLeft
'Find and delete terms
For Each a In arr
.Cells.Replace What:=a, Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Next a
'rows and colums here down
Set rng = Range(ws.Columns(1), Columns(ws.Cells.SpecialCells(xlCellTypeLastCell).Column()))
For Col = rng.Columns.Count To 1 Step -1
If Application.WorksheetFunction.CountA(rng.Columns(Col).EntireColumn) = 0 Then
rng.Columns(Col).EntireColumn.Delete
End If
Next Col
Set rng = Range(ws.Rows(1), Rows(ws.Cells.SpecialCells(xlCellTypeLastCell).Row()))
For Rw = rng.Rows.Count To 1 Step -1
If Application.WorksheetFunction.CountA(rng.Rows(Rw).EntireRow) = 0 Then
rng.Rows(Rw).EntireRow.Delete
End If
Next Rw
'insert cell for alignment
.Range("B1,D1").Insert Shift:=xlDown
Set rng = Range(ws.Rows(1), Rows(ws.Cells.SpecialCells(xlCellTypeLastCell).Row()))
For Rw = rng.Rows.Count To 1 Step -1
If Application.WorksheetFunction.CountA(rng.Rows(Rw).EntireRow) = 0 Then
rng.Rows(Rw).EntireRow.Delete
End If
Next Rw
'.Range("A:A").Formatdatetime("dd/mm/YYYY hh:mm:ss", convert"MMM")
.Cells.Interior.ColorIndex = xlNone
.Cells.EntireColumn.AutoFit
.Cells.EntireRow.AutoFit
End With
Next ws
Exits:
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub