Code deleting merged cells

[NightWalker]

I have the following code to remove all blank rows from my spreadsheet. The problem I am having is that the first row consists of merged cells and for some reason it is deleting this row. I am not understanding why. Could someone please give me some assistance. Thank you, --Walker

Public Sub DeleteBlankRows(xls As Object) 'xls is active worksheet being modified from other subroutine

Dim wks As Worksheet
Dim lngLastRow As Long, lngLastCol As Long, lngIdx As Long, _
    lngColCounter As Long
Dim blnAllBlank As Boolean

Set wks = xls

With wks
    'Now that our sheet is defined, we'll find the last row and last column
    lngLastRow = .Cells.Find(What:="*", LookIn:=xlFormulas, _
                             SearchOrder:=xlByRows, _
                             SearchDirection:=xlPrevious).Row
    lngLastCol = .Cells.Find(What:="*", LookIn:=xlFormulas, _
                             SearchOrder:=xlByColumns, _
                             SearchDirection:=xlPrevious).Column

    'Since we need to delete rows, we start from the bottom and move up
    For lngIdx = lngLastRow To 1 Step -1

        'Start by setting a flag to immediately stop checking
        'if a cell is NOT blank and initializing the column counter
        blnAllBlank = True
        lngColCounter = 2

        'Check cells from left to right while the flag is True
        'and the we are within the farthest-right column
        While blnAllBlank And lngColCounter <= lngLastCol

            'If the cell is NOT blank, trip the flag and exit the loop
            If .Cells(lngIdx, lngColCounter) <> "" Then
                blnAllBlank = False
            Else
                lngColCounter = lngColCounter + 1
            End If

        Wend

        'Delete the row if the blnBlank variable is True
        If blnAllBlank Then
            .Rows(lngIdx).Delete
        End If

    Next lngIdx
End With


'MsgBox "Blank rows have been deleted."

 End Sub

 

[Joe4]

Two things:

First, merged cells cause a ton of issues (especially with things like VBA and sorting), and should generally be avoided whenever possible. If you are just merging columns across single rows, you can achieve the exact same visual effect without any of the problems merged cells cause by using the "Center Across Selection" formatting option instead of using merged cells.

Second, if you never want to delete your header row, and it is row 1, simply exclude that from your loop by stopping at row instead of row 1, i.e.
For lngIdx = lngLastRow To 2 Step -1

 

[NightWalker]

The spreadsheet consists of data that i need from a manufacturer. They email me the spreadsheet and I am writing vba code to modify it to fix all the mistakes they make before they send it. The headers are supposed to be in row 3. How would you validate the headers and then make that row the stopping point?

 

[Joe4]

If you look at that line bolded in my previous post, that is your loop that tells you what lines to process against.
Earlier in the code, it is using a variable to dynamically capture the last row of data, and then it is looping backwards, from that last row up until whatever row number you tell it to stop.
It was originally one. But we could tell it to stop at row 4 (so skip the top 3 rows), simply by changing that number in red bold type in my previous post to a 4.

I think what will give you what you need, as long as you are not trying to delete any of the first 3 rows.

 

[NightWalker]

Thank you for the explanation. What I was trying to figure out now is how do i verify that the headers are actually in row 3. Would this be a new thread?

 

[Joe4]

Would this be a new thread?

It depends. We might be able to solve this rather simply without doing so, but it really depends on the answer to the next question.
What is the logic we are to use to determine where the headers exist?
Are we looking for a specific word or phrase in a specific column?

 

[NightWalker]

The headers would be specific words or phrases but they could be in different columns. That is part of what i have to fix when i get the emails. Im not sure what they are doing on their end but i have tried to get them to use a template i sent them. They usually send the same information in the same places but other times it is really messed up. I am just trying to get the correct information into the right places for processing into charts and things for presentation to the engineers.

 

[Joe4]

OK, but for us to try to program something for you, you have to give us something to go on.
We cannot program to broad, generic statements.

If you can just describe, in plain English, how you would determine where the header row is, then we might have something to work with.
For example, if there is some particular/unique word that always shows up in the header (let's say it is "Corporate"), even if you don't know what column it always may be in, you can say something like "Find the first instance of the word 'Corporate', and that is where the header row is".
Now that is something we can work with.

So, can you give us something like that?

 

[NightWalker]

I'm sorry for not including the necessary information. Here are the Headers that should be present.

S/N, Cap (nF), DF, Voltage Breakdown (mA), Corona (pC), Radial Res, Radial Keff, Thickness Res, Thickness Keff, Date

 

[Joe4]

OK, give this a try and see if it works. This should find your header row, and exclude that row and all rows above it:

Public Sub DeleteBlankRows(xls As Object) 'xls is active worksheet being modified from other subroutine

Dim wks As Worksheet
Dim lngLastRow As Long, lngLastCol As Long, lngIdx As Long, _
    lngColCounter As Long
Dim blnAllBlank As Boolean
Dim lngHdrRow As Long
Dim myFind As String

Set wks = xls

With wks
    'Now that our sheet is defined, we'll find the last row and last column
    lngLastRow = .Cells.Find(What:="*", LookIn:=xlFormulas, _
                             SearchOrder:=xlByRows, _
                             SearchDirection:=xlPrevious).Row
    lngLastCol = .Cells.Find(What:="*", LookIn:=xlFormulas, _
                             SearchOrder:=xlByColumns, _
                             SearchDirection:=xlPrevious).Column

    'Find where header row exists
'   *********************************************
    '***** ENTER HEADER VALUE TO SEARCH FOR *****
'   *********************************************
    myFind = "S/N"
    
'   Find header row
    On Error GoTo err_chk
    lngHdrRow = .Cells.Find(What:=myFind, After:=Range("A1"), LookIn:=xlFormulas, LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
        , SearchFormat:=False).Row
    On Error GoTo 0

    'Since we need to delete rows, we start from the bottom and move up
    For lngIdx = lngLastRow To (lngHdrRow + 1) Step -1

        'Start by setting a flag to immediately stop checking
        'if a cell is NOT blank and initializing the column counter
        blnAllBlank = True
        lngColCounter = 2

        'Check cells from left to right while the flag is True
        'and the we are within the farthest-right column
        While blnAllBlank And lngColCounter <= lngLastCol

            'If the cell is NOT blank, trip the flag and exit the loop
            If .Cells(lngIdx, lngColCounter) <> "" Then
                blnAllBlank = False
            Else
                lngColCounter = lngColCounter + 1
            End If

        Wend

        'Delete the row if the blnBlank variable is True
        If blnAllBlank Then
            .Rows(lngIdx).Delete
        End If

    Next lngIdx
End With


'MsgBox "Blank rows have been deleted."

'Error handling code:
Exit Sub
    
err_chk:
    If Err.Number = 91 Then
        MsgBox "Cannot find header search value of " & myFind, vbOKOnly, "ERROR!"
        Exit Sub
    Else
        MsgBox Err.Number & ": " & Err.Description
    End If

 End Sub