Find Last blank cell even when cell contains a formula

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
kwatt562Asked:
Who is Participating?
 
dlmilleConnect With a Mentor Commented:
That explains alot, then.  Note the reference to Sheet("Test") in assigning the original copy and the # of pastes.

Here's your solution, which matches the results you've anticipated.

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

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

    Set rng = Range("Thread_507")
    
    numPastes = Sheets("Test").Range("B2")
       
    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

Dave
trials1-r1.xlsm
0
 
dlmilleCommented:
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
0
 
dlmilleCommented:
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
0
Cloud Class® Course: Microsoft Exchange Server

The MCTS: Microsoft Exchange Server 2010 certification validates your skills in supporting the maintenance and administration of the Exchange servers in an enterprise environment. Learn everything you need to know with this course.

 
dlmilleCommented:
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
0
 
chwong67Commented:
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

0
 
rberkeConsultantCommented:
how about this

Set rng = Range("Thread_507")
 rng.EntireColumn.Cells(Evaluate("=MAX(IF(LEN(TRIM(test))=0,ROW(test),0))")).Select
0
 
kwatt562Author 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
0
 
dlmilleCommented:
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
0
 
rberkeConsultantCommented:
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

0
 
rberkeConsultantCommented:
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.
0
 
dlmilleCommented:
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
0
 
rberkeConsultantCommented:
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

0
 
rberkeConsultantCommented:
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

0
 
kwatt562Author 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
0
 
dlmilleCommented:
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
0
 
kwatt562Author 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
0
 
chwong67Commented:
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

0
 
kwatt562Author Commented:
Dave your a legend!, thanks a lot
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.