Sort Column, Delete Rows, Delete Column, Move Molumn, more inside?

**motown** · 05-09-2008, 05:19 PM

Looking for a macro that will go though a file similar to what is attached (attached is just much smaller scale xls file) and perform the following. Everything is on one sheet. The file this will be used in will start as, and remain a CSV file. Will that cause any problems? I have one built that deleted the row based on case criteria, but adding in the other items and actually deleteing the rows, not just the cell data, is more of what I'm looking for.

-

Sort By Serial Number

Delete all non check lines (lines with no data, or simply that doesn't match serial number pattern would be best)

Insert a column A

Insert a column call Type after serial number Description

Move description to end and delete data (starts in row 2)

Delete CR/DR column

Save and prompt to change name (not really needed)

**royUK** · 05-10-2008, 03:09 AM

You could make a start by using the macro recorder to get the basic code for adding a column, sorting etc.

**rbrhodes** · 05-10-2008, 03:30 AM

Hi motown.

Here's a first attempt base don your descriptions

**motown** · 05-12-2008, 11:33 AM

That works perfectly except for one small little detail. The "Description" Column C in the orignial doc ends up deleted, but should be move to follow the new "Type" column.

**motown** · 05-12-2008, 12:01 PM

n/m, I needed the column goen anyway.

**rbrhodes** · 05-12-2008, 12:14 PM

Hi Motown,

Small bug in code. If there was no data in Col D it was deleting the header row. This adapted line will fix that.

[vba]
Option Explicit

Sub AsRequested()

Dim fName As String
Dim LastRow As Long

Application.ScreenUpdating = False

Columns("A:A").Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Columns("A:A").Insert Shift:=xlToRight
Columns("E:E").Delete Shift:=xlToLeft
Columns("D:D").Insert Shift:=xlToRight
Range("D1") = "Type"

LastRow = Range("E65536").End(xlUp).Row

'//Adapted line
If LastRow > 1 Then
Range("E2:E" & LastRow).ClearContents
End If
'//

fName = InputBox("Enter filename to save as", "Filename?")

'ActiveWorkbook.SaveAs FileName:=fName, FileFormat:= _
xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False _
, CreateBackup:=False

Application.ScreenUpdating = True

End Sub
[/vba]

**motown** · 05-12-2008, 12:21 PM

Thanks a TON rbrhodes!

They changed things up on me a bit, and I think this is for the better as I actually have the actual file in hand and not what they "think" will be used. I have the "start" file with the base and the needs in the comments. And then I've added an "end" file with that they are looking to be the final product.

Does this help?