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

 

[jolivanes]

Why would you do as requested in 3 and then delete column (as in 5)?

 

[Drrellik]

I believe he wants to delete Rows based on column C first if they don't have EQ BE BL and BZ then delete column C afterwards

 

[jolivanes]

@Drrellik
You're right. I totally misread that.
Thanks

 

[Drrellik]

I used MrExcel years ago to help me put together some VBA to strip out columns and search for keywords similar to what he is asking for and I can modify it a little but not enough yet still learning.

 

[Drrellik]

Sub Delete_columns_()
' Check to see if their is data in Column H2:H200
' if H is empty then the macro has already run once
' dont run marco again and exit
If Application.WorksheetFunction.CountA(Range("H2:H200")) = 0 Then
MsgBox "Macro has already been run once."
    
    Exit Sub
End If
' Select all, copy, enter
' Removes any merged cells
    Cells.Select
    Selection.Copy
    ActiveSheet.Paste
    Application.CutCopyMode = False
' Delete Columns A,C,D,J,K,M,O,P - AH' in reverse order
' Removes unwanted or unneeded columns

Columns(34).EntireColumn.Delete
Columns(33).EntireColumn.Delete
Columns(32).EntireColumn.Delete
Columns(31).EntireColumn.Delete
Columns(30).EntireColumn.Delete
Columns(29).EntireColumn.Delete
Columns(28).EntireColumn.Delete
Columns(27).EntireColumn.Delete
Columns(26).EntireColumn.Delete
Columns(25).EntireColumn.Delete
Columns(24).EntireColumn.Delete
Columns(23).EntireColumn.Delete
Columns(22).EntireColumn.Delete
Columns(21).EntireColumn.Delete
Columns(20).EntireColumn.Delete
Columns(19).EntireColumn.Delete
Columns(18).EntireColumn.Delete
Columns(17).EntireColumn.Delete
Columns(16).EntireColumn.Delete
Columns(15).EntireColumn.Delete
Columns(13).EntireColumn.Delete
Columns(11).EntireColumn.Delete
Columns(10).EntireColumn.Delete
Columns(4).EntireColumn.Delete
Columns(3).EntireColumn.Delete
Columns(1).EntireColumn.Delete

' Remove word wrap and autofit text
        Cells.Select
    With Selection
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
    End With
    Cells.EntireColumn.AutoFit
    Cells.EntireRow.AutoFit

'Move Column H to B

    Columns("H:H").Select
    Selection.Copy
    Columns("B:B").Select
    Selection.Insert Shift:=xlToRight
    Range("B1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    
' DeleteRowsWithoutValues()
    Dim lastRow As Long
    Dim i As Long
    Dim valueToCheck As String
    Dim valuesArray As Variant
    Dim found As Boolean

    ' Values to check for in column C
    valuesArray = Array("EB", "BE", "BL", "BZ")

    ' Find the last row with data in column C
    lastRow = Cells(Rows.Count, "C").End(xlUp).Row

    ' Loop through each row from bottom to top
    For i = lastRow To 1 Step -1
        found = False ' Reset found flag for each row
        valueToCheck = Cells(i, "C").Value
        ' Check if valueToCheck is present in the valuesArray
        For j = LBound(valuesArray) To UBound(valuesArray)
            If valueToCheck = valuesArray(j) Then
                found = True
                Exit For ' Exit the loop if found
            End If
        Next j
        ' If valueToCheck is not found in valuesArray, delete the row
        If Not found Then
            Rows(i).Delete
        End If
    Next i
     Columns("C:C").Select
    Selection.Delete Shift:=xlToLeft
    Rows("1:1").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "Ticker"
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "Date"
    Range("C1").Select
    ActiveCell.FormulaR1C1 = "Open"
    Range("D1").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    ActiveCell.FormulaR1C1 = "High"
    Range("E1").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    ActiveCell.FormulaR1C1 = "Low"
    Range("F1").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    ActiveCell.FormulaR1C1 = "Close"
    Range("G1").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    ActiveCell.FormulaR1C1 = "Volume"
    Range("H1").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    ActiveCell.FormulaR1C1 = "O/I"
    Range("I1").Select

End Sub

Taken from a VBA program I got help with stripping out unwanted data from this forum about 10 years ago. and then doing some web searching to figure out how to change some of it to make it work. It is slow and sloppy I am sure but I like trying to learn while helping.

Someone please clean this up so I can review it and learn.

 

[Drrellik]

Columns("H:H").Select
Selection.Copy
Columns("B:B").Select
Selection.Insert Shift:=xlToRight
Range("B1").Select
ActiveSheet.Paste
Application.CutCopyMode = False

Change Copy to Cut

 

[Drrellik]

VBA - Deleting rows if certain cell values are not present

Hello everyone. I'm doing a project where I have to make selection within a lot of information (more than 20,000 rows of data). You can see in the image there are some columns. What I need to do is to DELETE every row where the F column or the H column has a different value from the following...

www.mrexcel.com

Always search the Forums for great answers and hints on what you are looking for ~DR

 

[Cubist]

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

 

[Drrellik]

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.