Macros for cleaning excel file

[anuradhagrewal]

Hi
This is the original file for which I seek your kind consideration.
This is the desired output file

I need your kind gesture and help to get the output file with the following parameters

1. Delete Column A ,C, D ,J,K,M,O,and P to AH completely.
2. After the given columns are deleted I request you that column having "TradDt" be inserted after Column A. In other words it becomes column B
3. Then Column C or "SctySrs" only those rows be left in the given worksheet which contain "EQ" ,"BE", "BL" and "BZ". All other rows not having these 4 values be completely deleted
4. Now I request that column B or "TradDt" the date format be changed to "yyyymmdd"
5. After this column C or "SctySrs" be completely deleted.
6. Finally I request that the header row be renamed as follows:

• Column A : <ticker>
• Column B : <date>
• Column C : <open>
• Column D : <high>
• Column E : <low>
• Column F : <close>
• Column G : <Volume>
• Column H : <o/i>

Please help dear members

Regards

Anu

 

[Cubist]

That is a lot cleaner. I do have a question though.

If you .delete column A then does B become A and so on..? thats why I deleted in reverse order.

I realized that shortly. I've edited the code above to delete all at once.

 

[Drrellik]

Thanks for making it cleaner and easier to learn from. ~DR

 

[anuradhagrewal]

Try on a copy.

Sub ModifyWorksheet()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim rowsToDelete As Range
    Dim columnsToDelete As Range

    ' Set the worksheet
    Set ws = ThisWorkbook.Sheets("Sheet1") ' Replace "Sheet1" with your actual sheet name

    ' Set the columns to delete
    Set columnsToDelete = Union(ws.Columns("A"), ws.Columns("C"), ws.Columns("D"), ws.Columns("J"), _
                                ws.Columns("K"), ws.Columns("M"), ws.Columns("O:AH"))

    ' Delete specified columns
    columnsToDelete.Delete
 
    ' Move "TradDt" column to column B
    ws.Columns("J:J").Cut Destination:=ws.Columns("B:B")
    ws.Columns("J:J").Delete

 
    ' Collect rows to delete
    lastRow = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row
    For i = lastRow To 2 Step -1
        If Not (ws.Cells(i, "C").Value Like "*EQ*" Or _
                ws.Cells(i, "C").Value Like "*BE*" Or _
                ws.Cells(i, "C").Value Like "*BL*" Or _
                ws.Cells(i, "C").Value Like "*BZ*") Then
            If rowsToDelete Is Nothing Then
                Set rowsToDelete = ws.Rows(i)
            Else
                Set rowsToDelete = Union(rowsToDelete, ws.Rows(i))
            End If
        End If
    Next i
 
    ' Delete collected rows
    If Not rowsToDelete Is Nothing Then
        rowsToDelete.Delete
    End If

    lastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
    For i = 2 To lastRow
        ws.Cells(i, "B").Value = Format(ws.Cells(i, "B").Value, "yyyymmdd")
    Next i
 
    ws.Columns("C:C").Delete
    ws.Columns("I:L").Delete
    ws.Columns("B:B").NumberFormat = "General"
 
    ' Rename header row
    ws.Cells(1, 1).Value = "<ticker>"
    ws.Cells(1, 2).Value = "<date>"
    ws.Cells(1, 3).Value = "<open>"
    ws.Cells(1, 4).Value = "<high>"
    ws.Cells(1, 5).Value = "<low>"
    ws.Cells(1, 6).Value = "<close>"
    ws.Cells(1, 7).Value = "<Volume>"
    ws.Cells(1, 8).Value = "<o/i>"
 
End Sub

I tried using this code it deletes everything and just leaves the first row

<ticker>

<date>

<open>

<high>

<low>

<close>

<Volume>

<o/i>

 

[Cubist]

Sub ModifyWorksheet()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim rowsToDelete As Range
    Dim columnsToDelete As Range

    ' Set the worksheet
    Set ws = ThisWorkbook.Sheets("Sheet1") ' Replace "Sheet1" with your actual sheet name

    ' Set the columns to delete
    Set columnsToDelete = Union(ws.Columns("A"), ws.Columns("C"), ws.Columns("D"), ws.Columns("J"), _
                                ws.Columns("K"), ws.Columns("M"), ws.Columns("O:AH"))

    ' Delete specified columns
    columnsToDelete.Delete
  
    ' Move "TradDt" column to column B
    ws.Columns("H:H").Cut
    Columns("B:B").Insert shift:=xlToRight


  
    ' Collect rows to delete
    lastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
    For i = lastRow To 2 Step -1
        If Not (ws.Cells(i, "C").Value Like "*EQ*" Or _
                ws.Cells(i, "C").Value Like "*BE*" Or _
                ws.Cells(i, "C").Value Like "*BL*" Or _
                ws.Cells(i, "C").Value Like "*BZ*") Then
            If rowsToDelete Is Nothing Then
                Set rowsToDelete = ws.Rows(i)
            Else
                Set rowsToDelete = Union(rowsToDelete, ws.Rows(i))
            End If
        End If
    Next i
  
    ' Delete collected rows
    If Not rowsToDelete Is Nothing Then
        rowsToDelete.Delete
    End If

    lastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
    For i = 2 To lastRow
        ws.Cells(i, "B").Value = Format(ws.Cells(i, "B").Value, "yyyymmdd")
    Next i
  
    ws.Columns("C:C").Delete
    ws.Columns("B:B").NumberFormat = "General"
  
    ' Rename header row
    ws.Cells(1, 1).Value = "<ticker>"
    ws.Cells(1, 2).Value = "<date>"
    ws.Cells(1, 3).Value = "<open>"
    ws.Cells(1, 4).Value = "<high>"
    ws.Cells(1, 5).Value = "<low>"
    ws.Cells(1, 6).Value = "<close>"
    ws.Cells(1, 7).Value = "<Volume>"
    ws.Cells(1, 8).Value = "<o/i>"
  
End Sub

 

[Cubist]

I tried using this code it deletes everything and just leaves the first row

<ticker>

<date>

<open>

<high>

<low>

<close>

<Volume>

<o/i>

Make sure your sheet name is correct. I was able to replicate the result. Maybe someone else can test the code in post #14 also.

 

[Drrellik]

Did you try #6. With the correction Cut instead of Copy I Posted in # 7

 

[jolivanes]

This should delete the columns and move the one column over.
Have not had time for the rest yet.

Sub Maybe()
    Range("A:A, C:D, J:K, M:M, O:AH").Delete
    Columns(Rows(1).Find("TradDt").Column).Cut
    Columns(2).Insert Shift:=xlToRight
End Sub

 

[jolivanes]

Try on a copy of your original.
Check and change references where required.

Sub Maybe()
Dim sc As Long
Range("A:A, C:D, J:K, M:M, O:AH").Delete
Columns(Rows(1).Find("TradDt").Column).Cut
Columns(2).Insert Shift:=xlToRight
sc = ActiveSheet.UsedRange.Columns.Count + 2
    With ActiveSheet.UsedRange
        .Parent.AutoFilterMode = False
            .AutoFilter 3, VBA.Array("EQ", "BE", "BL", "BZ"), xlFilterValues
                .Columns(sc).SpecialCells(12).Value = "Keep"
            .AutoFilter
        .Columns(Rows(1).Find("Keep").Column).SpecialCells(4).EntireRow.Delete
    End With
Application.Union(Cells(1, 3).EntireColumn, Rows(1).Find("Keep").EntireColumn).Delete Shift:=xlToLeft
Range("B:B").NumberFormat = "yyyymmdd"    'If they are real dates, not text looking like a date
Cells(1).Resize(, 8).Value = Array("<ticker>", "<date>", "<open>", "<high>", "<low>", "<close>", "<Volume>", "<o/i>")
End Sub

 

[jolivanes]

If everything is working as you want it, maybe you can let us know so we can delete the files we used to make sure we helped you as good as we can.