Thread: Code to delete 2nd percent in Excel (Excel xp)

1. Code to delete 2nd percent in Excel (Excel xp)

I have a workbook with multiple worksheets. I need to go through each worksheet and delete the 2nd percentage if there are 2 in a row. So i need to delete B4:U4 and move A4 up to A3. I put some of them in red.

I made a "New" worksheet to show how i would like the sheets to come out after the 2nd percent is deleted.

How can i make a macro to do this as i have 400 worksheets to go through.

Thank you for the help.

2. Re: Code to delete 2nd percent in Excel (Excel xp)

Put the following code into a standard module:

Sub Delete2ndPercentages(oSheet As Worksheet)
Dim lngRow As Long
For lngRow = oSheet.Cells(65536, 2).End(xlUp).Row To 2 Step -1
If IsPercent(oSheet.Cells(lngRow, 2)) Then
If IsPercent(oSheet.Cells(lngRow - 1, 2)) Then
oSheet.Cells(lngRow - 1, 1) = oSheet.Cells(lngRow, 1)
oSheet.Rows(lngRow).Delete
End If
End If
Next lngRow
End Sub

Function IsPercent(oCell As Range) As Boolean
IsPercent = InStr(oCell.NumberFormat, "%") > 0
End Function

Call the procedure like this:

Delete2ndPercentages Worksheets("Original")

Notes:
- Your use of "2 in a row" is confusing if you are talking about a spreadsheet <img src=/S/evilgrin.gif border=0 alt=evilgrin width=15 height=15>
- The placement of "Total Answering" in the 'New' sheet is inconsistent.

3. Re: Code to delete 2nd percent in Excel (Excel xp)

Hi Hans,

Thank you very much. That works great! Now i realize i want to delete the cells that are NOT in COL A, that have text. How do i write a function that is like

Function IsText(oCell As Range) As Boolean
IsText = code to see if the cell has text in it
End Function

so i can delete those rows as well. Thanks

4. Re: Code to delete 2nd percent in Excel (Excel xp)

Excel has a worksheet function ISTEXT, so you can use that:

IsText = Application.WorksheetFunction.IsText(oCell)

5. Re: Code to delete 2nd percent in Excel (Excel xp)

Does this do what you want:

<pre>Public Sub DelRows()
Dim lLastRow As Long, I As Long
Dim oCell As Range, oWks As Worksheet, oMergedRange As Range
Set oWks = Worksheets("Original")
Set oCell = oWks.Range("B1")
lLastRow = oWks.Range("B65536").End(xlUp).Row - 1
For I = lLastRow To 1 Step (-1)
If Right(oCell.Offset(I, 0).Text, 1) = "%" And Right(oCell.Offset(I - 1, 0).Text, 1) = "%" Then
Set oMergedRange = oCell.Offset(I, -1).MergeArea
oMergedRange.UnMerge
oCell.Offset(I, 0).EntireRow.Delete
oMergedRange.Merge
End If
Next I
End Sub
</pre>

Posting Permissions

• You may not post new threads
• You may not post replies
• You may not post attachments
• You may not edit your posts
•