We help IT Professionals succeed at work.

Find Last blank cell even when cell contains a formula

kwatt562
kwatt562 asked
on
978 Views
Last Modified: 2012-06-22
Hi, Is there a way to modify the code below to go to the next blank cell in a column, even when the cell contains a formula (no value)?
Sub lastrow()

Dim LastColumn As Long
'Copy WO to Machine Selector

Range("A2").Select
Selection.Copy

'Find last blank cell in named range

Sheets("Machine Selector").Select
Dim rng As Range
On Error GoTo BodemUp
Set rng = Range("Thread_507")
rng.Cells.SpecialCells(xlCellTypeBlanks).Cells(1).Select

'Paste WO to last blank cell in named range

ActiveSheet.Paste
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent2
        .TintAndShade = 0.399975585192419
        .PatternTintAndShade = 0
        End With
Exit Sub
BodemUp: MsgBox "Machine is Full Today"




End Sub
Comment
Watch Question

Most Valuable Expert 2012
Top Expert 2012

Commented:
Assuming all the cells in range "Thread_507" have contiguous data (re: no blank cells, EXCEPT at the bottom), your approach is sound.  However, this approach will not flag a blank cell as a cell that has a formula, but has blank data.

Another approach, with a bit more processing, is as follows:

 
Sub lastrow()
Dim LastColumn As Long
Dim myCell As Range
Dim rng As Range
'Copy WO to Machine Selector

Range("A2").Select
Selection.Copy

'Find last blank cell in named range

Sheets("Machine Selector").Select
On Error GoTo BodemUp
Set rng = Range("Thread_507")

For Each myCell In rng
    If myCell.Value = "" Then
        myCell.Select
        Exit For
    End If
Next myCell

'rng.Cells.SpecialCells(xlCellTypeBlanks).Cells(1).Select

'Paste WO to last blank cell in named range

ActiveSheet.Paste
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent2
        .TintAndShade = 0.399975585192419
        .PatternTintAndShade = 0
        End With
Exit Sub
BodemUp: MsgBox "Machine is Full Today"




End Sub

Open in new window


This will, of course, paste on the FIRST blank cell in the range, even if there's a formula there and the result equals "".  The paste will erase that formula.

Dave
Most Valuable Expert 2012
Top Expert 2012

Commented:
The below is a modification, ensuring that a blank cell was found in Thread_507, or it goes to the BodemUp statement...

Sub lastrow()
Dim LastColumn As Long
Dim myCell As Range
Dim rng As Range
Dim foundBlank As Boolean

'Copy WO to Machine Selector

    Range("A2").Select
    Selection.Copy
    
    'Find last blank cell in named range
    
    Sheets("Machine Selector").Select
    On Error GoTo BodemUp
    Set rng = Range("Thread_507")
    
    Set myCell = rng.Find("")
    
    foundBlank = False
    For Each myCell In rng
        If myCell.Value = "" Then
            myCell.Select
            foundBlank = True
            Exit For
        End If
    Next myCell
    
    If Not foundBlank Then GoTo BodemUp
    'rng.Cells.SpecialCells(xlCellTypeBlanks).Cells(1).Select
    
    'Paste WO to last blank cell in named range
    
    ActiveSheet.Paste
        With Selection.Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .ThemeColor = xlThemeColorAccent2
            .TintAndShade = 0.399975585192419
            .PatternTintAndShade = 0
            End With
    Exit Sub
    
BodemUp: MsgBox "Machine is Full Today"

End Sub

Open in new window


Dave
Most Valuable Expert 2012
Top Expert 2012

Commented:
Unfortunately, even a range.find command will not work to find the next blank cell, if a formula is in the range equal to blank, so traversing through each cell, testing for "" (e.g., if mycell.value = "") is required to find that cell.

Dave

Commented:
Suggest to check the color of the blank cell... Amended as below
Sub lastrow()
Dim LastColumn As Long
Dim myCell As Range
Dim rng As Range
Dim foundBlank As Boolean

'Copy WO to Machine Selector

    Range("A2").Select
    Selection.Copy
    
    'Find last blank cell in named range
    
    Sheets("Machine Selector").Select
    On Error GoTo BodemUp
    Set rng = Range("Thread_507")
    
    Set myCell = rng.Find("")
    
    foundBlank = False
    For Each myCell In rng
        If myCell.Value = "" And _
           myCell.Interior.ThemeColor <> xlThemeColorAccent2 Then 'Check Color
            myCell.Select
            foundBlank = True
            Exit For
        End If
    Next myCell
    
    If Not foundBlank Then GoTo BodemUp
    'rng.Cells.SpecialCells(xlCellTypeBlanks).Cells(1).Select
    
    'Paste WO to last blank cell in named range
    
    ActiveSheet.Paste
        With Selection.Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .ThemeColor = xlThemeColorAccent2
            .TintAndShade = 0.399975585192419
            .PatternTintAndShade = 0
            End With
    Exit Sub
    
BodemUp: MsgBox "Machine is Full Today"

End Sub

Open in new window

rberkeConsultant

Commented:
how about this

Set rng = Range("Thread_507")
 rng.EntireColumn.Cells(Evaluate("=MAX(IF(LEN(TRIM(test))=0,ROW(test),0))")).Select

Author

Commented:
Thanks  a lot for your comments, the coding works, although Daves second post works best for what Im trying to do. I winder if I could ask another question based on the same code?
Is it possible to repeat the macro based on a value in a cell? for example the cell that I want to copy to the last free cell is A2 (as stated in above code), in B2 is a numeric value, the numeric value represents the number of times I want to copy the cell A2 to the next avaialble cell in "Machine Selector", is that possible?

cheers
Most Valuable Expert 2012
Top Expert 2012

Commented:
That should not be a problem - I assume you want to stay within the range "Thread_507"?  If the # of times to copy exceeds that, fill what can be filled, then popup the warning?

Dave
rberkeConsultant

Commented:
Just curious if you found something that was wrong with my solution?  It is faster because it does not need to loop through every cell. I think it works fine.

Here it is in a similar form to dave's second post.
Sub LASTROW()
Dim LastColumn As Long
Dim myCell As Range
Dim rng As Range
Dim foundBlank As Boolean

'Copy WO to Machine Selector

    Range("A2").Select
    Selection.Copy
    
    'Find last blank cell in named range
    
    Sheets("Machine Selector").Select
    On Error GoTo BodemUp
    Set rng = Range("Thread_507")
    
    
 Set rng = Range("Thread_507")
    Dim lngLASTROW As Long
    lngLASTROW = Evaluate("=MAX(IF(LEN(TRIM(Thread_507))=0,ROW(Thread_507),0))")
    If lngLASTROW = 0 Then GoTo BodemUp
    rng.EntireColumn.Cells(lngLASTROW).Select
    

    'Paste WO to last blank cell in named range
    
    ActiveSheet.Paste
        With Selection.Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .Color = vbRed ' I HAVE 2003 NOT EXCEL 2007 SO I AM HIGHLIGHTING WITH RED
            ' .ThemeColor = xlThemeColorAccent
            ' .TintAndShade = 0.399975585192419
            ' .PatternTintAndShade = 0
            End With
    Exit Sub
    
BodemUp:  "Machine is Full Today"

End Sub

Open in new window

rberkeConsultant

Commented:
Oh, now I see.  I was giving you the LAST non blank like it said in the title. You body said you want  the NEXT non-blank.

Disregard my post, it will not do what you want.
Most Valuable Expert 2012
Top Expert 2012

Commented:
Routine modified as requested:

 
Sub lastrow()
Dim LastColumn As Long
Dim myCell As Range
Dim rng As Range
Dim foundBlanks As Long
Dim numPastes As Long

'Copy WO to Machine Selector

    Range("A2").Select
    Selection.Copy
    
    'Find last blank cell in named range
    
    Sheets("Machine Selector").Select

    Set rng = Range("Thread_507")
    
    numPastes = Range("B2")
    
    Set myCell = rng.Find("")
    
    foundBlanks = 0
    For Each myCell In rng
        If myCell.Value = "" And foundBlanks < numPastes Then
            myCell.Select
                'Paste WO to last blank cell in named range
    
            ActiveSheet.Paste
            With Selection.Interior
                .Pattern = xlSolid
                .PatternColorIndex = xlAutomatic
                .ThemeColor = xlThemeColorAccent2
                .TintAndShade = 0.399975585192419
                .PatternTintAndShade = 0
            End With
    
            foundBlanks = foundBlanks + 1

        End If
    Next myCell
    
    If foundBlanks <> numPastes Then
        MsgBox "Machine is Full Today - Could only paste " & foundBlanks, vbOKOnly, "Machine is Full!"
    End If
End Sub

Open in new window


See attached demo file.

Enjoy!

Dave
lastRow-Routine-r1.xls
rberkeConsultant

Commented:
Try this one
Sub LastRow()
Dim LastColumn As Long
Dim myCell As Range
Dim rng As Range
Dim foundBlank As Boolean

'Copy WO to Machine Selector

    Range("A2").Select
    Selection.Copy
    
    'Find last blank cell in named range
    
    Sheets("Machine Selector").Select
    On Error GoTo BodemUp
    Set rng = Range("Thread_507")
    
    
 Set rng = Range("Thread_507")
    Dim lngLastRow As Long
    
    lngLastRow = Evaluate("=MATCH(0,INDEX(LEN(TRIM(Thread_507)),0),FALSE)") + rng.Row - 1
    
    If lngLastRow = 0 Then GoTo BodemUp
    rng.EntireColumn.Cells(lngLastRow).Select
    

    'Paste WO to last blank cell in named range
    
    ActiveSheet.Paste
        With Selection.Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .Color = vbRed ' I HAVE 2003 NOT EXCEL 2007 SO I AM HIGHLIGHTING WITH RED
            ' .ThemeColor = xlThemeColorAccent
            ' .TintAndShade = 0.399975585192419
            ' .PatternTintAndShade = 0
            End With
    Exit Sub
    
BodemUp: MsgBox Error$ & "Machine is Full Today"

End Sub

Open in new window

rberkeConsultant

Commented:
My solution used a neat trick to replace the "seach for blank" loop with a single statement.

But, the new requirement that it be repeated multiple times reintroduces the need for a loop, which takes away most of the value of my trick.  Probably points go to Dave.  Nonetheless, you should examine my tricks and see if you understand them. They are often useful in other applications.

rberke

Author

Commented:
Thanks a lot guys, however I get type mismatch when I try to run the routine from Dave, I attach my file, so its clearer. The sheet "Test" is where i am running the macro from.
trials1.xlsm
Most Valuable Expert 2012
Top Expert 2012

Commented:
Well, there's no data in cell B2 - where you suggested the number of pastes to do should be.  Also cell A2 has the value "Week 1".  Please look at your request, then compare to the file you presented...

Dave

Author

Commented:
Hi
A2 on "Test" copies to the first blank cell in "machine selector", adding further WO will fill the timeline from left to right. B2 on "Test" contains the number of pastes
So on the sheet I sent A2 is 407889 and B2 is 4, so 407889 should copy to the first blank cell in Machine selector, which is cell C2, it should copy a further 3 times to D2, E2 and F2 (thus filling the timeline)

cheers

Commented:
Try to move your B2 as below Amended...
'Copy WO to Machine Selector
    numPastes = Range("B2") '<---Move your B2 here
    Range("A2").Select
    Selection.Copy
    
    'Find last blank cell in named range
    
    Sheets("Machine Selector").Select

    Set rng = Range("Thread_507")
    'numPastes = Range("B2")

Open in new window

Most Valuable Expert 2012
Top Expert 2012
Commented:
Unlock this solution and get a sample of our free trial.
(No credit card required)
UNLOCK SOLUTION

Author

Commented:
Dave your a legend!, thanks a lot
Unlock the solution to this question.
Thanks for using Experts Exchange.

Please provide your email to receive a sample view!

*This site is protected by reCAPTCHA and the Google Privacy Policy and Terms of Service apply.

OR

Please enter a first name

Please enter a last name

8+ characters (letters, numbers, and a symbol)

By clicking, you agree to the Terms of Use and Privacy Policy.