Learn how to a build a cloud-first strategyRegister Now

x
?
Solved

Find Last blank cell even when cell contains a formula

Posted on 2011-04-24
18
Medium Priority
?
960 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
0
Comment
Question by:kwatt562
  • 7
  • 5
  • 4
  • +1
18 Comments
 
LVL 42

Expert Comment

by:dlmille
ID: 35457398
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
 
LVL 42

Expert Comment

by:dlmille
ID: 35457409
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
 
LVL 42

Expert Comment

by:dlmille
ID: 35457410
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
VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

 
LVL 9

Expert Comment

by:chwong67
ID: 35457564
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
 
LVL 5

Expert Comment

by:rberke
ID: 35457936
how about this

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

Author Comment

by:kwatt562
ID: 35458411
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
 
LVL 42

Expert Comment

by:dlmille
ID: 35460285
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
 
LVL 5

Expert Comment

by:rberke
ID: 35461348
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
 
LVL 5

Expert Comment

by:rberke
ID: 35461389
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
 
LVL 42

Expert Comment

by:dlmille
ID: 35461406
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
 
LVL 5

Expert Comment

by:rberke
ID: 35461488
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
 
LVL 5

Expert Comment

by:rberke
ID: 35461569
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
 

Author Comment

by:kwatt562
ID: 35462325
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
 
LVL 42

Expert Comment

by:dlmille
ID: 35462543
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
 

Author Comment

by:kwatt562
ID: 35462935
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
 
LVL 9

Expert Comment

by:chwong67
ID: 35463694
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
 
LVL 42

Accepted Solution

by:
dlmille earned 2000 total points
ID: 35463726
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
 

Author Comment

by:kwatt562
ID: 35464996
Dave your a legend!, thanks a lot
0

Featured Post

Important Lessons on Recovering from Petya

In their most recent webinar, Skyport Systems explores ways to isolate and protect critical databases to keep the core of your company safe from harm.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Freeze panes is an option within all variants of Excel to enable parts of a sheet to remain stationary when the cursor is in another part of the sheet. This is a very useful feature which is overlooked or under used.
This article describes how you can use Custom Document Properties to store settings and other information in your workbook so that they will be available the next time you open the workbook.
The viewer will learn how to use the =DISCRINV command to create a discrete random variable, use this command to model a set of probabilities and outcomes in a Monte Carlo simulation, and learn how to find the standard deviation of a set of probabil…
This Micro Tutorial will demonstrate on a Mac how to change the sort order for chart legend values and decrpyt the intimidating chart menu.

804 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question