Home > OS >  Reliably get Last Column in Excel with or without Merged Cells
Reliably get Last Column in Excel with or without Merged Cells

Time:11-18

I recently ran into an issue where my get_lcol function returned A1 as the cells in A1:D1 were merged. I adapted my function to account for this, but then I had some other data with cells merged in A1:D1 but another column in G and my function returned D1 so I adjusted it again. The problem is I don't trust it still to work with all data types as its only checking merged cells in row 1.

Take a look at the below data, how can I reliably get the function to return D or 4 regardless of where I move the merged row and/or any other issues I haven't foreseen?

Current Function:

Public Sub Test_LCol()
 Debug.Print Get_lCol(ActiveSheet)
End Sub

Public Function Get_lCol(WS As Worksheet) As Integer
 Dim sEmpty As Boolean
 On Error Resume Next
 sEmpty = IsWorksheetEmpty(Worksheets(WS.Name))
 If sEmpty = False Then
  Get_lCol = WS.Cells.Find(What:="*", after:=[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
  If IsMerged(Cells(1, Get_lCol)) = True Then
   If Get_lCol < Cells(1, Get_lCol).MergeArea.Columns.Count Then
    Get_lCol = Cells(1, Get_lCol).MergeArea.Columns.Count
   End If
  End If
 Else
  Get_lCol = 1
 End If
End Function

Update:

Try this data w/ function:

enter image description here

enter image description here

CodePudding user response:

@Toddleson got me on the right track, here is what I ended with:

Public Sub Test_LCol()
 Debug.Print Get_lCol(ActiveSheet)
End Sub

Public Function Get_lCol(WS As Worksheet) As Integer
 On Error Resume Next
 If Not IsWorksheetEmpty(WS) Then
  Get_lCol = WS.Cells.Find(What:="*", after:=[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
  Dim Cell As Range
  For Each Cell In WS.UsedRange
   If Cell.MergeCells Then
    With Cell.MergeArea
     If .Cells(.Cells.Count).Column > Get_lCol Then Get_lCol = .Cells(.Cells.Count).Column
    End With
   End If
  Next Cell
 Else
  Get_lCol = 1
 End If
End Function

CodePudding user response:

This is a twist on the classic "Find Last Cell" problem

To state the aim:

  • find the column number of the right most cell containing data
  • consider merged cell areas that extend beyond other cells containing data. Return the right most column of a merged area should that extend beyond other data.
  • exclude formatted but empty cells and merged areas

The approach:

  • Use Range.Find to locate the last data cell
  • If the last column of the Used Range = Found last data cell column, return that
  • Else, loop from the last column of the Used Range back to the found data cell column
    • test for data in that column (.Count > 0), if true return that
    • test for merged cells in that column (IsNull(.MergeCells))
      • if found, loop to find the merged area
      • test the left most cell of the merged area for data
      • if found return the search column

Note

  • this may still be vulnerable to other "Last data" issues, eg Autofilter, Hidden rows/columns etc. I haven't tested those cases.
  • Has the advantage of limiting the search for merged cells to the relavent right most columns
Function MyLastCol(ws As Worksheet) As Long
    Dim ur As Range
    Dim lastcell As Range
    Dim col As Long
    Dim urCol As Range
    Dim urCell As Range
    
    Set ur = ws.UsedRange
    
    Set lastcell = ws.Cells.Find("*", ws.Cells(1, 1), xlFormulas, , xlByColumns, xlPrevious)
    
    For col = ur.Columns.Count To lastcell.Column - ur.Column   2 Step -1
        Set urCol = ur.Columns(col)
        If Application.CountA(urCol) > 0 Then
            MyLastCol = urCol.Column
            Exit Function
        End If
        If IsNull(urCol.MergeCells) Then
            For Each urCell In urCol.Cells
                If urCell.MergeCells Then
                    If Not IsEmpty(urCell.MergeArea.Cells(1, 1)) Then
                        MyLastCol = urCol.Column
                        Exit Function
                    End If
                End If
            Next
        End If
    Next
    MyLastCol = lastcell.Column
End Function

CodePudding user response:

The Find Method Backed Up by the UsedRange Property: What?

  • Talking about wasting time...
Option Explicit

Function GetLastColumn( _
    ByVal ws As Worksheet) _
As Long
    If ws Is Nothing Then Exit Function
    
    ' Using the 'Find' method:
    'If ws.AutoFilterMode Then ws.AutoFilterMode = False ' (total paranoia)
    Dim lcCell As Range
    Set lcCell = ws.Cells.Find("*", , xlFormulas, , xlByColumns, xlPrevious)
    If Not lcCell Is Nothing Then
        GetLastColumn = lcCell.Column
    End If
    Debug.Print "After 'Find':     " & GetLastColumn
    
    ' Using the 'UsedRange' property (paranoia):
    Dim rg As Range: Set rg = ws.UsedRange
    Dim clColumn As Long: clColumn = rg.Columns.Count   rg.Column - 1
    If clColumn > GetLastColumn Then
        If rg.Address(0, 0) = "A1" Then
            If IsEmpty(rg) Then
                Exit Function
            End If
        End If
        GetLastColumn = clColumn
    'Else ' clColumn is not gt GetLastColumn
    End If
    Debug.Print "Final (if not 0): " & GetLastColumn
    
End Function

Sub GetLastColumnTEST()
    Debug.Print "Sub Result:       " & GetLastColumn(Sheet1)
    Debug.Print Sheet1.UsedRange.Address(0, 0)
End Sub

' It works for a few (?) cells, otherwise it returns 'Null'.
Sub TestMergeCells() ' Useless?! Could someone confirm.
    Debug.Print Sheet1.Cells.MergeCells ' Null for sure
    Debug.Print Sheet1.UsedRange.MergeCells
End Sub
  • Related