Rationalise Code

[pioshelby1980com]

Hi guys,

I have the following code that does exactly as I want but for the last portion that inserts a cell border. The only way I can get the border to work is to run it for each column. I need to do it from column 2 to column 16. That is going to be inefficient. Is there another way to do that?

Sub DeleteRowsInColumnM_ActiveSheet()
Dim lastRow As Long
Dim lastRow1 As Long
Dim i As Long

' Find the last row in column M of the active sheet
lastRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, "M").End(xlUp).Row

' Find the last row in column D of the active sheet
lastRow1 = ActiveSheet.Cells(ActiveSheet.Rows.Count, "D").End(xlUp).Row

' Loop through each row in column M
For i = 1 To lastRow
' Check if the current cell in column M contains the target text
If InStr(1, ActiveSheet.Cells(i, 13).Value, "CE Order No.") > 0 Then ' Column M is the 13th column
' Delete the current row
ActiveSheet.Rows(i).Delete
ActiveSheet.Rows(i).Delete
ActiveSheet.Rows(i).Delete
' Delete the row 3 rows below the current row
'ActiveSheet.Rows(i + 2).Delete
' Since a row is deleted, decrement the loop counter to recheck the current row
i = i - 1
End If
Next i



' Loop through each row in column D
For i = 1 To lastRow1
' Check if the current cell in column D contains the target text
If InStr(1, ActiveSheet.Cells(i, 4).Value, "Total amount across all CE Orders") > 0 Then ' Column D is the 4th column
' Delete the current row
ActiveSheet.Rows(i).Delete
ActiveSheet.Rows(i).Delete
ActiveSheet.Rows(i).Delete
ActiveSheet.Cells(i - 1, 2).Borders(xlEdgeBottom).LineStyle = xlContinuous
ActiveSheet.Cells(i - 1, 2).Borders(xlEdgeBottom).Color = RGB(68, 114, 196)
ActiveSheet.Cells(i - 1, 2).Borders(xlEdgeBottom).Weight = xlThick

ActiveSheet.Cells(i - 1, 3).Borders(xlEdgeBottom).LineStyle = xlContinuous
ActiveSheet.Cells(i - 1, 3).Borders(xlEdgeBottom).Color = RGB(68, 114, 196)
ActiveSheet.Cells(i - 1, 3).Borders(xlEdgeBottom).Weight = xlThick

ActiveSheet.Cells(i - 1, 4).Borders(xlEdgeBottom).LineStyle = xlContinuous
ActiveSheet.Cells(i - 1, 4).Borders(xlEdgeBottom).Color = RGB(68, 114, 196)
ActiveSheet.Cells(i - 1, 4).Borders(xlEdgeBottom).Weight = xlThick

ActiveSheet.Cells(i - 1, 5).Borders(xlEdgeBottom).LineStyle = xlContinuous
ActiveSheet.Cells(i - 1, 5).Borders(xlEdgeBottom).Color = RGB(68, 114, 196)
ActiveSheet.Cells(i - 1, 5).Borders(xlEdgeBottom).Weight = xlThick
' Since a row is deleted, decrement the loop counter to recheck the current row
i = i - 1
End If
Next i
End Sub

 

[mumps]

It would be easier to help if you could use the XL2BB add-in (icon in the menu) to attach a screenshot (not a picture) of your sheet. Alternately, you could upload a copy of your file to a free site such as www.box.com or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. Explain in detail what you want to do referring to specific cells, rows, columns and sheets using a few examples from your data (de-sensitized if necessary).