Select next available cell without any value in it

I

ipbr21054

Well-known Member
Joined
Nov 16, 2010
Messages
5,226
Office Version
  1. 2007
Platform
  1. Windows
Afternoon,
I currently using this code below so it runs when i open the worksheet.

Code: 
Private Sub Worksheet_Activate()Range("A4").Activate
End Sub

I am only interested in Column A
The range is ALWAYS A4:A28

What i would like please "as opposed to going to A4" is that when i open the worksheet the next available cell in column A without and value etc is selected.

So example would be cell A22 has a value in it so it would then select cell A23


The code for the page is currently shown below

Code: 
Private Sub CommandButton1_Click()  Sheets("EXPENSES (2)").Range("D4").Value = Sheets("EXPENSES (1)").Range("D30").Value
  Sheets("EXPENSES (2)").Range("F4:K4").Value = Sheets("EXPENSES (1)").Range("F30:K30").Value
  Sheets("EXPENSES (2)").Activate
  ActiveSheet.Range("A5").Select
  If Sheets("EXPENSES (2)").Range("K32").Value <> Sheets("EXPENSES (1)").Range("K32").Value Then MsgBox "Balance of sheets incorrect", vbCritical, "K32 CELLS DO NOT MATCH"
End Sub
Private Sub CommandButton2_Click()
Dim Answer As Long, wb As Workbook
    Answer = MsgBox("Transfer Values To Summary Sheet ?", vbYesNo + vbInformation, "End Of Month Accounts")
    If Answer = vbYes Then
        Set wb = Workbooks.Open(Filename:="C:\Users\Ian\Desktop\EBAY\ACCOUNTS\CURRENT SHEETS\SUMMARY SHEET.xlsm")
        Workbooks("ACCOUNTS.xlsm").Sheets("EXPENSES (1)").Range("D30").Copy
        wb.Sheets("Sheet1").Range("I28").PasteSpecial xlPasteValues
        
        Workbooks("ACCOUNTS.xlsm").Sheets("EXPENSES (1)").Range("F30").Copy
        wb.Sheets("Sheet1").Range("I29").PasteSpecial xlPasteValues
        
        Workbooks("ACCOUNTS.xlsm").Sheets("EXPENSES (1)").Range("G30").Copy
        wb.Sheets("Sheet1").Range("I30").PasteSpecial xlPasteValues
        
        Workbooks("ACCOUNTS.xlsm").Sheets("EXPENSES (1)").Range("H30").Copy
        wb.Sheets("Sheet1").Range("I31").PasteSpecial xlPasteValues
        
        Workbooks("ACCOUNTS.xlsm").Sheets("EXPENSES (1)").Range("I30").Copy
        wb.Sheets("Sheet1").Range("I32").PasteSpecial xlPasteValues
        
        Workbooks("ACCOUNTS.xlsm").Sheets("EXPENSES (1)").Range("J30").Copy
        wb.Sheets("Sheet1").Range("I33").PasteSpecial xlPasteValues
        
        Workbooks("ACCOUNTS.xlsm").Sheets("EXPENSES (1)").Range("K30").Copy
        wb.Sheets("Sheet1").Range("I34").PasteSpecial xlPasteValues
        wb.Close True


        End If
        Workbooks("ACCOUNTS.xlsm").Sheets("EXPENSES (1)").Range("A4").Select
        Application.CutCopyMode = False
        MsgBox "Summary Transfer Completed", vbInformation, "SUCCESSFUL MESSAGE"
        ActiveWorkbook.Save
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim myStartCol As String
    Dim myEndCol As String
    Dim myStartRow As Long
    Dim myLastRow As Long
    Dim myRange As Range


    If Target.Cells.Count > 1 Then Exit Sub
    
    Application.ScreenUpdating = False
    
'   *** Specify columns to apply this to ***
    myStartCol = "A"
    myEndCol = "K"


'   *** Specify start row ***
    If (Target.Row > 3 And Target.Row < 29) Then
          myStartRow = 4
    Else: myStartRow = 29
    End If
'   Use first column to find the last row
    If (Target.Row > 3 And Target.Row < 29) Then
          myLastRow = 28
    Else: myLastRow = 30
    End If
    
'   Build range to apply this to
    Set myRange = Range(Cells(myStartRow, myStartCol), Cells(myLastRow, myEndCol))
    
'   Clear the color of all the cells in range
    Range("A4:K30").Interior.ColorIndex = 2
    
'   Check to see if cell selected is outside of range
    If Intersect(Target, myRange) Is Nothing Then Exit Sub
    
'   This color will Highlight the row
    If (Target.Row > 3 And Target.Row < 29) Then
    Range(Cells(Target.Row, myStartCol), Cells(Target.Row, myEndCol)).Interior.ColorIndex = 8
'   This color will Highlight the column
    Range(Cells(4, Target.Column), Cells(28, Target.Column)).Interior.ColorIndex = 8
    Else
    Range(Cells(Target.Row, myStartCol), Cells(Target.Row, myEndCol)).Interior.ColorIndex = 3
    End If
'   This color will Highlight the cell in the row
    If (Target.Row > 3 And Target.Row < 29) Then
    Target.Interior.Color = vbGreen
    Else
    Target.Interior.Color = vbRed
    End If
    Application.ScreenUpdating = True


End Sub
Private Sub Worksheet_Change(ByVal Target As Range)


'   Exit if more than one cell updated at a time
    If Target.Count > 1 Then Exit Sub


'   Check to see if value updated is in column B or D
    If Target.Column = 2 Or Target.Column = 4 Then
        Application.EnableEvents = False
        If UCase(Cells(Target.Row, "B")) = "REFUND" Then
            Cells(Target.Row, "D") = Abs(Cells(Target.Row, "D")) * -1
        Else
            If Cells(Target.Row, "B") = "" Then Cells(Target.Row, "D").ClearContents
        End If
        Application.EnableEvents = True
    End If
    If Not (Application.Intersect(Target, Range("A3:K28")) _
      Is Nothing) Then
        With Target
            If Not .HasFormula Then
                Application.EnableEvents = False
                .Value = UCase(.Value)
                Application.EnableEvents = True
            End If
        End With
    End If
End Sub


Private Sub Worksheet_Activate()
Range("A4").Activate
End Sub
 

Excel Facts

Why does 9 mean SUM in SUBTOTAL?
It is because Sum is the 9th alphabetically in Average, Count, CountA, Max, Min, Product, StDev.S, StDev.P, Sum, VAR.S, VAR.P.
Sort by date Sort by votes
Does A4:A28 always fill from the top-down, without skipping any cells?
If so, then maybe try this:
Code: 
Range("A29").End(xlUp).Offset(1,0).Select
That starts in cell A29, and goes up until it finds the last populated cell, then moves down one (to the first unpopulated cell).
Is that what you are looking for?

If all the cells may be populated, you may also want to add some code to first check to see if A28 is already populated, and then if it is, skip over that line of code, as all cells are full.
 
Last edited:
Upvote 0
Hi,
For some reason on one sheet it selects cell A29 when it should of selected cell A24
I applied it like so.

Code: 
Private Sub Worksheet_Activate()Range("A29").End(xlUp).Offset(1, 0).Select
End Sub
 
Upvote 0
For some reason on one sheet it selects cell A29 when it should of selected cell A24
Click to expand...
Is there anything in cell A28?
What does this formula return?
=LEN(A28)

Please show us what your data in range A4:A29 looks like in this example that doesn't work for you.
 
Upvote 0
This is the code on the page in question.

Code: 
Private Sub CommandButton1_Click()  Sheets("INCOME (2)").Range("C4:D4").Value = Sheets("INCOME (1)").Range("C30:E30").Value
  Sheets("INCOME (2)").Range("F4").Value = Sheets("INCOME (1)").Range("F30").Value
  Sheets("INCOME (2)").Activate
  ActiveSheet.Range("A5").Select
  If Sheets("INCOME (2)").Range("G32").Value <> Sheets("INCOME (1)").Range("G32").Value Then MsgBox "Balance of sheets incorrect", vbCritical, "G32 CELLS DO NOT MATCH"
End Sub
Private Sub CommandButton2_Click()
Dim Answer As Long, wb As Workbook
    Answer = MsgBox("Transfer Values To Summary Sheet ?", vbYesNo + vbInformation, "End Of Month Accounts")
    If Answer = vbYes Then
        Set wb = Workbooks.Open(Filename:="C:\Users\Ian\Desktop\EBAY\ACCOUNTS\CURRENT SHEETS\SUMMARY SHEET.xlsm")
        Workbooks("ACCOUNTS.xlsm").Sheets("INCOME (1)").Range("E32").Copy
        wb.Sheets("Sheet1").Range("I26").PasteSpecial xlPasteValues
        
        Workbooks("ACCOUNTS.xlsm").Sheets("INCOME (1)").Range("F32").Copy
        wb.Sheets("Sheet1").Range("I27").PasteSpecial xlPasteValues
        wb.Close True


        End If
        Workbooks("ACCOUNTS.xlsm").Sheets("INCOME (1)").Range("A5").Select
        Application.CutCopyMode = False
        MsgBox "Summary Transfer Completed", vbInformation, "SUCCESSFUL MESSAGE"
        ActiveWorkbook.Save
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim myStartCol As String
    Dim myEndCol As String
    Dim myStartRow As Long
    Dim myLastRow As Long
    Dim myRange As Range


    If Target.Cells.Count > 1 Then Exit Sub
    
    Application.ScreenUpdating = False
    
'   *** Specify columns to apply this to ***
    myStartCol = "A"
    myEndCol = "G"


'   *** Specify start row ***
    If (Target.Row > 3 And Target.Row < 29) Then
          myStartRow = 4
    Else: myStartRow = 29
    End If
'   Use first column to find the last row
    If (Target.Row > 3 And Target.Row < 29) Then
          myLastRow = 28
    Else: myLastRow = 30
    End If
    
'   Build range to apply this to
    Set myRange = Range(Cells(myStartRow, myStartCol), Cells(myLastRow, myEndCol))
    
'   Clear the color of all the cells in range
    Range("A4:G30").Interior.ColorIndex = 2
    
'   Check to see if cell selected is outside of range
    If Intersect(Target, myRange) Is Nothing Then Exit Sub
    
'   This color will Highlight the row
    If (Target.Row > 3 And Target.Row < 29) Then
    Range(Cells(Target.Row, myStartCol), Cells(Target.Row, myEndCol)).Interior.ColorIndex = 8
'   This color will Highlight the column
    Range(Cells(4, Target.Column), Cells(28, Target.Column)).Interior.ColorIndex = 8
    Else
    Range(Cells(Target.Row, myStartCol), Cells(Target.Row, myEndCol)).Interior.ColorIndex = 3
    End If
'   This color will Highlight the cell in the row
    If (Target.Row > 3 And Target.Row < 29) Then
    Target.Interior.Color = vbGreen
    Else
    Target.Interior.Color = vbRed
    End If
    Application.ScreenUpdating = True


End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Intersect(Target, Range("E4:E30")) Is Nothing Then
    Application.EnableEvents = False
    Range("E4:E30").Formula = "=IF(C4="""","""",C4+D4)"
    Application.EnableEvents = True
  End If
  
'   Exit if more than one cell updated at a time
    If Target.Count > 1 Then Exit Sub


'   Check to see if value updated is in column B or D
    If Target.Column = 2 Or Target.Column = 3 Then
        Application.EnableEvents = False
        If UCase(Cells(Target.Row, "B")) = "REFUND" Then
            Cells(Target.Row, "C") = Abs(Cells(Target.Row, "C")) * -1
        Else
            If Cells(Target.Row, "B") = "" Then Cells(Target.Row, "C").ClearContents
        End If
        Application.EnableEvents = True
    End If
    If Not (Application.Intersect(Target, Range("A3:G28")) _
      Is Nothing) Then
        With Target
            If Not .HasFormula Then
                Application.EnableEvents = False
                .Value = UCase(.Value)
                Application.EnableEvents = True
            End If
        End With
    End If


End Sub
Private Sub Worksheet_Activate()
Range("A29").End(xlUp).Offset(1, 0).Select
End Sub


The cells with values in are A4:A23

A4:A28 is DATE
A29:A30 is GENERAL

Having said that the new worksheet has 99.9% code the same as the one shown above but works ok.

[CODE]Private Sub CommandButton1_Click()
  Sheets("INCOME (3)").Range("C4:D4").Value = Sheets("INCOME (2)").Range("C30:E30").Value
  Sheets("INCOME (3)").Range("F4").Value = Sheets("INCOME (2)").Range("F30").Value
  Sheets("INCOME (3)").Activate
  ActiveSheet.Range("A5").Select
  If Sheets("INCOME (3)").Range("G32").Value <> Sheets("INCOME (2)").Range("G32").Value Then MsgBox "Balance of sheets incorrect", vbCritical, "G32 CELLS DO NOT MATCH"
End Sub
Private Sub CommandButton2_Click()
Dim Answer As Long, wb As Workbook
    Answer = MsgBox("Transfer Values To Summary Sheet ?", vbYesNo + vbInformation, "End Of Month Accounts")
    If Answer = vbYes Then
        Set wb = Workbooks.Open(Filename:="C:\Users\Ian\Desktop\EBAY\ACCOUNTS\CURRENT SHEETS\SUMMARY SHEET.xlsm")
        Workbooks("ACCOUNTS.xlsm").Sheets("INCOME (2)").Range("E32").Copy
        wb.Sheets("Sheet1").Range("I26").PasteSpecial xlPasteValues
        
        Workbooks("ACCOUNTS.xlsm").Sheets("INCOME (2)").Range("F32").Copy
        wb.Sheets("Sheet1").Range("I27").PasteSpecial xlPasteValues
        wb.Close True


        End If
        Workbooks("ACCOUNTS.xlsm").Sheets("INCOME (2)").Range("A5").Select
        Application.CutCopyMode = False
        MsgBox "Summary Transfer Completed", vbInformation, "SUCCESSFUL MESSAGE"
        ActiveWorkbook.Save
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim myStartCol As String
    Dim myEndCol As String
    Dim myStartRow As Long
    Dim myLastRow As Long
    Dim myRange As Range


    If Target.Cells.Count > 1 Then Exit Sub
    
    Application.ScreenUpdating = False
    
'   *** Specify columns to apply this to ***
    myStartCol = "A"
    myEndCol = "G"


'   *** Specify start row ***
    If (Target.Row > 4 And Target.Row < 29) Then
          myStartRow = 5
    Else: myStartRow = 29
    End If
'   Use first column to find the last row
    If (Target.Row > 4 And Target.Row < 29) Then
          myLastRow = 28
    Else: myLastRow = 30
    End If
    
'   Build range to apply this to
    Set myRange = Range(Cells(myStartRow, myStartCol), Cells(myLastRow, myEndCol))
    
'   Clear the color of all the cells in range
    Range("A5:G30").Interior.ColorIndex = 2
    
'   Check to see if cell selected is outside of range
    If Intersect(Target, myRange) Is Nothing Then Exit Sub
    
'   This color will Highlight the row
    If (Target.Row > 4 And Target.Row < 29) Then
    Range(Cells(Target.Row, myStartCol), Cells(Target.Row, myEndCol)).Interior.ColorIndex = 8
'   This color will Highlight the column
    Range(Cells(5, Target.Column), Cells(28, Target.Column)).Interior.ColorIndex = 8
    Else
    Range(Cells(Target.Row, myStartCol), Cells(Target.Row, myEndCol)).Interior.ColorIndex = 3
    End If
'   This color will Highlight the cell in the row
    If (Target.Row > 4 And Target.Row < 29) Then
    Target.Interior.Color = vbGreen
    Else
    Target.Interior.Color = vbRed
    End If
    Application.ScreenUpdating = True


End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Intersect(Target, Range("E4:E30")) Is Nothing Then
    Application.EnableEvents = False
    Range("E4:E30").Formula = "=IF(C4="""","""",C4+D4)"
    Application.EnableEvents = True
  End If
  
'   Exit if more than one cell updated at a time
    If Target.Count > 1 Then Exit Sub


'   Check to see if value updated is in column B or D
    If Target.Column = 2 Or Target.Column = 3 Then
        Application.EnableEvents = False
        If UCase(Cells(Target.Row, "B")) = "REFUND" Then
            Cells(Target.Row, "C") = Abs(Cells(Target.Row, "C")) * -1
        Else
            If Cells(Target.Row, "B") = "" Then Cells(Target.Row, "C").ClearContents
        End If
        Application.EnableEvents = True
    End If
    If Not (Application.Intersect(Target, Range("A3:G28")) _
      Is Nothing) Then
        With Target
            If Not .HasFormula Then
                Application.EnableEvents = False
                .Value = UCase(.Value)
                Application.EnableEvents = True
            End If
        End With
    End If


End Sub


Private Sub Worksheet_Activate()
Range("A29").End(xlUp).Offset(1, 0).Select
End Sub

[/CODE]

I have also noticed this which my say something.

I enter a date in cells A1 A2 A3
i open the sheet & cell A4 is selected,which is good.
I then delete the vales in cells A1 A2 A3 save then close.
When i open the sheet again cell A4 gets selected agin.

Not sure where to put the LEN code you mention
 
Upvote 0
You didn't answer any of the questions I asked in my two replies. Please, help me to help you, and go back and read my replies and answer the questions I posed.

Not sure where to put the LEN code you mention
Click to expand...
Put it in any blank cell on your sheet, and tell me what it returns.

It would be very helpful to see what the data in A4:A29 in your example looks like.
 
Upvote 0
For some reason on one sheet it selects cell A29 when it should of selected cell A24
Click to expand...
I cannot reproduce this behavior.
Do you have any merged cells?

Without seeing an image of what the data looks like in A4:A29, I cannot reproduce your environment to reproduce your results.
If A28 is truly blank, it should work, unless you got other stuff going on there (like merged cells).
 
Upvote 0
I suspect A4:A28 are part of a table with blanks
if so, maybe this
Code: 
For i = 28 To 4 Step -1
    If Cells(i - 1, "A") <> "" Then
        Cells(i, "A").Select
        Exit For
    End If
Next
 
Upvote 0
You must log in or register to reply here.

Similar threads

I
  • Solved
Code to apply only to my table range
Replies
3
Views
351
Alex Blakenburg
A
E
  • Question
Issues When Using VBA to Automatically Move Row to Another Sheet Based On Cell Value
2 3
Replies
21
Views
2K
EBe
E
R
  • Question
Cannot Force UDF to Calculate
Replies
2
Views
309
RichardBX
R
The Ruff Report
  • Solved
VBA - replace a character in a range to save
Replies
5
Views
173
RobP
R
I
  • Solved
Vba Call function shows subscript out of range
Replies
9
Views
418
ipbr21054
I

Forum statistics

Threads
1,214,805
Messages
6,121,656
Members
449,045
Latest member
Marcus05

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top