# NONBLANKVALUES

Remove the blanks from a single column of data.
For instructions on how to add a function to a workbook refer to the page under Inserting Functions

enter as an array formula returns an array to multiple cells

`'rgeValues - 'lArrayFormulaSize - 'bIncludeRowNo - Public Function NONBLANKVALUES(ByVal rgeValues As Range, _                              ByVal lArrayFormulaSize As Long, _                     Optional ByVal bIncludeRowNo As Boolean = False) As Variant Dim lrowno As Long Dim larrayno As Long Dim avalues As Variant Dim iupper As Integer    If bIncludeRowNo = False Then iupper = 1    If bIncludeRowNo = True Then iupper = 2    ReDim avalues(1 To iupper, 1 To rgeValues.Rows.Count)    For lrowno = 1 To rgeValues.Rows.Count       If Len(rgeValues.Parent.Cells(rgeValues.Row + lrowno - 1, rgeValues.Column).Value) > 0 Then          avalues(1, 1 + larrayno) = rgeValues.Parent.Cells(rgeValues.Row + lrowno - 1, rgeValues.Column).Value          If bIncludeRowNo = True Then             avalues(2, 1 + larrayno) = rgeValues.Row + lrowno - 1          End If          larrayno = larrayno + 1       End If    Next lrowno       ReDim Preserve avalues(1 To iupper, 1 To lArrayFormulaSize)    For lrowno = (larrayno + 1) To lArrayFormulaSize       avalues(1, lrowno) = ""       If bIncludeRowNo = True Then          avalues(2, lrowno) = ""       End If    Next lrowno       avalues = Application.WorksheetFunction.Transpose(avalues)    NONBLANKVALUES = avalues End Function Function NoBlanks(DataRange As Range) As Variant() ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''  ' NoBlanks' This function returns an array that consists of the non-blank values ' in DataRange. The function must be array-entered into the complete range ' of worksheet cells that are to receive the result. For example, if ' you want the results in B1:B10, select that range, type'       =NOBLANKS(A1:A10)' in B1 and press CTRL+SHIFT+ENTER rather than just enter.' This will cause the function to fill B1:B10 with the N non-blank ' entries in A1:A10, and place vbNullStrings in N+1 to 10.' The input DataRange must have exactly 1 row or 1 column. You ' can't enter a two-dimensional array. The formula must be ' entered into a single column or singe row. You cannot ' enter the formula in a two dimensional array. If the formula ' is entered into a two-dimensional range, or if DataRange is a ' two dimensional range, the function will return #REF errors.' The size of the array is the greater of the number of cells ' into which it was entered and the number of cells in the input ' DataRange.'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''Dim N As Long Dim N2 As Long Dim Rng As Range Dim MaxCells As Long Dim Result() As Variant Dim R As Long Dim C As Long If (DataRange.Rows.Count > 1) And _     (DataRange.Columns.Count > 1) Then     '''''''''''''''''''''''''''''''''''''''''''''''''    ' If DataRange is a two-dimensional array, fill    ' it with #REF errors. We work with only    ' single dimensional ranges.    '''''''''''''''''''''''''''''''''''''''''''''''''    ReDim Result(1 To DataRange.Rows.Count, 1 To DataRange.Columns.Count)     For R = 1 To UBound(Result, 1)         For C = 1 To UBound(Result, 2)             Result(R, C) = CVErr(xlErrRef)         Next C     Next R     NoBlanks = Result     Exit Function End If If (Application.Caller.Rows.Count > 1) And _     (Application.Caller.Columns.Count > 1) Then     '''''''''''''''''''''''''''''''''''''''''''''''''    ' If Application.Caller is a two-dimensional array, fill    ' it with #REF errors. We work with only    ' single dimensional ranges.    '''''''''''''''''''''''''''''''''''''''''''''''''    ReDim Result(1 To Application.Caller.Rows.Count, 1 To Application.Caller.Columns.Count)     For R = 1 To UBound(Result, 1)         For C = 1 To UBound(Result, 2)             Result(R, C) = CVErr(xlErrRef)         Next C     Next R     NoBlanks = Result     Exit Function End If '''''''''''''''''''''''''''''''''''''''''''''''''''''' Get the greater of Application.Caller.Cells.Count ' and DataRange.Cells.Count. This is the size ' of the array we'll return. Sizing it to the ' maximum value prevents #N/A error from appearing ' in cells past the end of the array, because ' the array will always fill out the cells ' into which it was entered.'''''''''''''''''''''''''''''''''''''''''''''''''''''MaxCells = Application.WorksheetFunction.Max( _     Application.Caller.Cells.Count, DataRange.Cells.Count) ''''''''''''''''''''''''''''''''''''''''''''' Resize the array to the proper size.''''''''''''''''''''''''''''''''''''''''''''ReDim Result(1 To MaxCells, 1 To 1) ''''''''''''''''''''''''''''''''''''''''''''' Loop through DataRange and place non-blank ' cells at the front of the array.''''''''''''''''''''''''''''''''''''''''''''For Each Rng In DataRange.Cells     If Rng.Value <> vbNullString Then         N = N + 1         Result(N, 1) = Rng.Value     End If Next Rng ''''''''''''''''''''''''''''''''''''''''''''' Fill the remaining array elements with ' vbNullStrings so they don't appear ' as 0 on the worksheet.''''''''''''''''''''''''''''''''''''''''''''For N2 = N + 1 To MaxCells     Result(N2, 1) = vbNullString Next N2 '''''''''''''''''''''''''''''''''''''''''''' If the formula was entered into a single ' row across several columns, Transpose the ' result array.'''''''''''''''''''''''''''''''''''''''''''If Application.Caller.Rows.Count = 1 Then     NoBlanks = Application.Transpose(Result) Else     NoBlanks = Result End If End Function `

© 2024 Better Solutions Limited