Macro: I can delete, now want to add formulas

[jtf]

I have a macro that is called "Delete Junk" which strips out unnecessary columns and rows from a workbook I download 2-3 times a week. The code is listed below.

Now I need this macro to also add columns and perform calcs.

For instance, after the steps below are done, I'm left with columns A-V. I now want to add a few more columns starting at W.

for W I'd like to do this:
=V2*0.1112 in W2
fill down to the end of the worksheet rows.

For AA I'd like to do this in AA2
=IF(Y2>Z2,Z2,Y2)
and then fill down to the end of the worksheet rows.

And so on. I have about 15 other columns with formulas I'd like to add, and one of them being the =Hyperlink formula.

Can this be done?
And is my original macro clean and doing it the right way?

Thanks,
Jeff

Sub DeleteJunk()
Dim FilterRange As Range
FinalRow = Cells(Rows.Count, 1).End(xlUp).Row

'Delete rows 1 thru 13
Range("A1:A11").EntireRow.Delete

'Delete rows where column(a)="District:"
Set FilterRange = Range("A2:AC" & FinalRow)
FilterRange.AutoFilter Field:=1, Criteria1:="District:"
FilterRange.SpecialCells(xlCellTypeVisible).EntireRow.Delete

'Delete blue rows
For Each c In Range("A3:AC" & FinalRow)
If c.Interior.ColorIndex = 35 Then c.EntireRow.Delete
Next

'Delete all rows that contain no data
Dim i As Long
Dim lLastRow As Long
lLastRow = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
Application.ScreenUpdating = False
For i = lLastRow To 1 Step -1
If WorksheetFunction.CountA(ActiveSheet.Rows(i)) = 0 Then
ActiveSheet.Rows(i).EntireRow.Delete
End If
Next i
Application.ScreenUpdating = True

'Find last column with data in Row 1
lastCol = Cells(1, Columns.Count).End(xlToLeft).Column
'Loop through columns, starting at the last one
For delCol = lastCol To 1 Step -1
'Delete columns with Vendor in Row 1
If Cells(1, delCol) = "Vendor" Then _
Cells(1, delCol).EntireColumn.Delete
Next

'Find last column with data in Row 1
lastCol = Cells(1, Columns.Count).End(xlToLeft).Column
'Loop through columns, starting at the last one
For delCol = lastCol To 1 Step -1
'Delete columns with Name Me in Row 1
If Cells(1, delCol) = "Seq No" Then _
Cells(1, delCol).EntireColumn.Delete
Next

'Find last column with data in Row 1
lastCol = Cells(1, Columns.Count).End(xlToLeft).Column
'Loop through columns, starting at the last one
For delCol = lastCol To 1 Step -1
'Delete columns with Name Me in Row 1
If Cells(1, delCol) = "Lifetime Mwh Sum" Then _
Cells(1, delCol).EntireColumn.Delete
Next

'Find last column with data in Row 1
lastCol = Cells(1, Columns.Count).End(xlToLeft).Column
'Loop through columns, starting at the last one
For delCol = lastCol To 1 Step -1
'Delete columns with Name Me in Row 1
If Cells(1, delCol) = "Net KW" Then _
Cells(1, delCol).EntireColumn.Delete
Next

'Find last column with data in Row 1
lastCol = Cells(1, Columns.Count).End(xlToLeft).Column
'Loop through columns, starting at the last one
For delCol = lastCol To 1 Step -1
'Delete columns with Name Me in Row 1
If Cells(1, delCol) = "Net KWH" Then _
Cells(1, delCol).EntireColumn.Delete
Next

'Find last column with data in Row 1
lastCol = Cells(1, Columns.Count).End(xlToLeft).Column
'Loop through columns, starting at the last one
For delCol = lastCol To 1 Step -1
'Delete columns with Name Me in Row 1
If Cells(1, delCol) = "Total Lifetime Saving Units" Then _
Cells(1, delCol).EntireColumn.Delete
Next

End Sub

 

[dave3009]

You could try something like this

Sub DeleteJunk()
Dim FilterRange As Range
finalRow = Cells(Rows.Count, 1).End(xlUp).Row

'Delete rows 1 thru 13
Range("A1:A11").EntireRow.Delete

'Delete rows where column(a)="District:"
Set FilterRange = Range("A2:AC" & finalRow)
FilterRange.AutoFilter Field:=1, Criteria1:="District:"
FilterRange.SpecialCells(xlCellTypeVisible).EntireRow.Delete

'Delete blue rows
For Each c In Range("A3:AC" & finalRow)
If c.Interior.ColorIndex = 35 Then c.EntireRow.Delete
Next

'Delete all rows that contain no data
Dim i As Long
Dim lLastRow As Long
lLastRow = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
Application.ScreenUpdating = False
For i = lLastRow To 1 Step -1
If WorksheetFunction.CountA(ActiveSheet.Rows(i)) = 0 Then
ActiveSheet.Rows(i).EntireRow.Delete
End If
Next i
Application.ScreenUpdating = True

'Find last column with data in Row 1
lastCol = Cells(1, Columns.Count).End(xlToLeft).Column
'Loop through columns, starting at the last one
For delCol = lastCol To 1 Step -1
    Select Case Cells(1, delCol)
        Case "Vendor": Cells(1, delCol).EntireColumn.Delete
        Case "Seq No": Cells(1, delCol).EntireColumn.Delete
        Case "Lifetime Mwh Sum": Cells(1, delCol).EntireColumn.Delete
        Case "Net KW": Cells(1, delCol).EntireColumn.Delete
        Case "Net KWH": Cells(1, delCol).EntireColumn.Delete
        Case "Total Lifetime Saving Units": Cells(1, delCol).EntireColumn.Delete
    End Select
Next delCol

Range("W2:W" & lastCol).Formula = "=V2*0.1112"
Range("AA2:AA" & lastCol).Formula = "=IF(Y2>Z2,Z2,Y2)"

End Sub

 

[jtf]

OK great, that seems to work. Thanks Dave!
Now, I need to add a header for those new columns, and I would like to format them.
How can I do that?
Is there VB code for format paint?

 

[dave3009]

Something like

Next delCol

Range("W1").Value = "Heading 1"
Range("AA1").Value = "Heading 2"

Range("A1").Copy
Range("W1:AA1").PasteSpecial xlPasteFormats

Range("W2:W" & lastCol).Formula = "=V2*0.1112"
Range("AA2:AA" & lastCol).Formula = "=IF(Y2>Z2,Z2,Y2)"

End Sub

 

[jtf]

Again, thanks a lot Dave.
One more thing not working: the =HYPERLINK formula. My hyperlink formula includes quotation marks which is breaking the formula embedded in this macro.

The formula should be this:

=HYPERLINK("https://mywebsite.com/DsmWeb/do/application/sbs/customer/View?applicationId="&A2&"",A2)

As you can see, the "&A2&" is completing the URL by putting whatever is in A2 into that location of the URL.

But if I were to do that in the macro the same way I did the others, there would be quotes nested within quotes that break it. Any way around that?

Range("AD2:AD" & lastCol).Formula = "=HYPERLINK("https://mywebsite.com/DsmWeb/do/application/sbs/customer/View?applicationId="&A2&"",A2)"

 

[jtf]

Sorry, besides the Hyperlink formula above, I have a few others.

Need to format Range ("AC2:AC" & lastCol) to Arial 8 and Percent Style number format.

Format Range ("AD2:AD" & lastCol) to blue underlined Arial 8 to make it look like a hyperlink.

Format Range("AK2:AK" & lastCol) to Arial 8 and a number format with 1 decimal place

And format Range("AQ2:AQ" & lastCol) to Arial 8 and a number format with 2 decimal places.

Also, is there a way to have it size the column widths? Most columns are OK but one of them is way too narrow.

And finally, I'd like it to end with the cursor at A2 and A1 not selected anymore (box is around it from copying A1).

Is there a chart I can find that shows all of these formatting commands?
Thanks again!

 

[jtf]

OK figured out the column width:

Columns("AC").Select
Selection.ColumnWidth = 6.57

Still working on the formatting. Something is happening now that is stopping my new calcs on Row 29, when I have 4720 rows that I need to fill out.

 

[jtf]

Fixed calcs stopping at Row 29. Had "lastColumn" instead of "finalRow"

 

[dave3009]

The HYPERLINK would be

=HYPERLINK("https://mywebsite.com/DsmWeb/do/application/sbs/customer/View?applicationId="&Range("A2") & "," & Range("A2")&")"

Though you might be better off using the correct Hyperlink.Add VB function.

The other formatting could be solved by running the macro recorder and using the code produced.