Trying to have a button to select next non empty/blank cell in column A, relative to current row. The code below works, but only if active cell is in column A.
Need it to work on column A, even when active cell is in another column.
Private Sub CommandButton3_Click() 'Next step button - selects next step in A column
Dim n As Long
n = Cells(Rows.Count, ActiveCell.Column).End(xlUp).Row
If ActiveCell.Row = n Then MsgBox "Last one, no more instructions.": Exit Sub
If ActiveCell.Offset(1, 0) = "" Then
ActiveCell.End(xlDown).Select
Else
ActiveCell.Offset(1, 0).Select
End If
End Sub
The problem is your activecell is in the wrong column. You need to address that:
Private Sub CommandButton3_Click() 'Next step button - selects next step in A column
Dim n As Long, fixed_range As Range
Set fixed_range = ActiveSheet.Cells(ActiveCell.Row, 1)
n = Cells(Rows.Count, fixed_range.Column).End(xlUp).Row
If fixed_range.Row = n Then MsgBox "Last one, no more instructions.": Exit Sub
If fixed_range.Offset(1, 0) = "" Then
fixed_range.End(xlDown).Select
Else
fixed_range.Offset(1, 0).Select
End If
End Sub
This uses a "fixed_range" to make sure we're working on column 1.
Related
I am trying to set up a VBA form that will find the next empty column in a table and populate the empty cells using values entered into a form.
The current code basically finds the next empty cell in column B and resets the form after submitting it.
I will post images of the table and form I am using below.
Code:
Private Sub addButton1_Click()
If surfactantCountBox.Value = "" Or wetterCountBox.Value = "" Or causticCountBox.Value = "" Then
If MsgBox("Form is not complete. Do you want to continue?", vbQuestion + vbYesNo) <> vbYes Then
UserForm1.surfactantCountBox.SetFocus
Exit Sub
End If
End If
Call findEmpty
Call resetForm
End Sub
Sub resetForm()
surfactantCountBox.Value = ""
wetterCountBox.Value = ""
causticCountBox.Value = ""
UserForm1.surfactantCountBox.SetFocus
End Sub
Sub findEmpty()
Dim ws As Worksheet
Set ws = ActiveSheet
For Each cell In ws.Columns(2).Cells
If IsEmpty(cell) = True Then cell.Select: Exit For
Next cell
End Sub
ws.Columns(2) refers to column B - your code is looking at each cell in column B, so will return the last row if anything.
Having said that, you don't have to look at each row/column. Manually you can find the last column by going to the last cell - e.g. cell XFD2 and pressing Ctrl + Left which will take you to the last column in row 2.
To do this in code:
Sub findEmpty()
Dim ws As Worksheet
Set ws = ActiveSheet
Dim NextEmptyCell As Range
With ws
'This is the same as going to XFD2 and pressing Ctrl+Left and then going one cell right.
Set NextEmptyCell = .Cells(2, .Columns.Count).End(xlToLeft).Offset(, 1)
End With
Debug.Print NextEmptyCell.Address
End Sub
This is one way to find the next empty column in row 2.
Set rngEmpty = ActiveSheet.Cells(2, Columns.Count).End(xlToRight).Offset(, 1)
We could incorporate that into the rest of the code to add the data from the userform.
Private Sub addButton1_Click()
Dim rngEmpty As Range
If surfactantCountBox.Value = "" Or wetterCountBox.Value = "" Or causticCountBox.Value = "" Then
If MsgBox("Form is not complete. Do you want to continue?", vbQuestion + vbYesNo) <> vbYes Then
Me.surfactantCountBox.SetFocus
Exit Sub
End If
End If
Set rngEmpty = ActiveSheet.Cells(2, Columns.Count).End(xlToRight).Offset(, 1)
With rngEmpty
.Value = Me.surfactantCountBox.Value
.Offset(1).Value = Me.causticCountBox.Value
.Offset(2).Value = Me.wetterCountBox.Value
End With
Call resetForm
End Sub
I am beginner at VBA, I am stuck plz help. In this image(linked at the end of paragraph), I am trying to insert line above the cells which contains different name than the name of upper cell. Plz tell me if there is an easier way to do this or how to apply the given if else condition to whole "G" Column...
Still I am adding my code below if you don't need the image...
Sub ScanColumn()
'Application.ScreenUpdating = False
Dim varRange As Range
Dim currentCell As String
Dim upperCell As String
Dim emptyCell As String
currentCell = ActiveCell.Value
bottomCell = ActiveCell.Offset(1, 0).Value
emptyCell = ""
Dim intResult As Integer
intResult = StrComp(bottomCell, currentCell)
Dim emptyResult As Integer
emptyResult = StrComp(currentCell, emptyCell)
'I want to apply below condition to whole G column in used range
If emptyResult = 0 Then
ActiveCell.Select
ElseIf intResult = 0 Then
ActiveCell.Offset(1, 0).Select
Else
ActiveCell.Offset(1).EntireRow.Insert
ActiveCell.Offset(2, 0).Select
End If
End Sub
Here you have, just call the function "evaluateColumn" and pass the parameters, as example the "trial" sub.
Function evaluateColumn(column As String, startRow As Long, wsh As Worksheet)
Dim lastRow As Long
lastRow = wsh.Range(column & wsh.Rows.Count).End(xlUp).Row
Dim i As Long: i = startRow
Do While i < lastRow
If wsh.Cells(i, column).Value <> wsh.Cells(i + 1, column).Value And wsh.Cells(i, column).Value <> "" And wsh.Cells(i + 1, column).Value <> "" Then
wsh.Range(column & i + 1).EntireRow.Insert shift:=xlShiftDown, CopyOrigin:=xlFormatFromLeftOrAbove
i = i + 1
lastRow = lastRow + 1
End If
i = i + 1
Loop
End Function
Sub trial()
evaluateColumn "G", 2, ThisWorkbook.Worksheets("Sheet2")
End Sub
As you can see from the difference between my answer and the one below, your question isn't entirely clear. My code is an event procedure. It will run automatically, as you select a cell within the used range of column G.
If the value of the selected cell is the same as the cell below it the next row's cell will be selected.
If there is a value in either of the two cells, a blank row will be inserted and that row's cell selected. (If you want another row enable the row below the insertion.)
If either of the above conditions are true, do nothing and proceed with the selection the user made.
In order to let this code work it must be installed in the code sheet of the worksheet on which you want the action. It will not work if you install it in a standard code module, like Module1.
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim TriggerRange As Range
Dim Off As Long ' offset from Target for selection
' if more than one cell is selected choose the first cell
If Target.Cells.CountLarge > 1 Then Set Target = ActiveCell
Set TriggerRange = Range(Cells(2, "G"), Cells(Rows.Count, "G").End(xlUp))
' this code will run only if a cell in this range is selected
' Debug.Print TriggerRange.Address(0, 0)
If Not Application.Intersect(Target, TriggerRange) Is Nothing Then
Application.EnableEvents = False
With Target
If .Value = .Offset(1).Value Then
Off = 1
ElseIf WorksheetFunction.CountA(.Resize(2, 1)) Then
Rows(.Row).Insert
' Off = 1 ' or -1 to change the selection
End If
.Offset(Off).Select
End With
Application.EnableEvents = True
End If
End Sub
I,ve tried to find a VBA solution for finding the previous cell (located on the same row) with different value than the selected cell has. So if the selected cell is for example [N6] (as in my picture) then my search range should be ("A6:N6") from which I need to find the last cell with a different cell value (which would be cell [L6] in my picture because it's the previous cell with a different value than cell [N6]. The search should start from the end (N6,M6,L6...) backwards until the first match is found (first different cell value). When the first match is found then select it. I have hundreds of columns, so my picture is just to show the principle. I execute my vba code with Private Sub Worksheet_SelectionChange(ByVal Target As Range) so when the user selects a cell with the mouse. I get the desired cell with {=ADDRESS(6;MATCH(2;1/(A6:O6<>"D")))} but I would need a VBA solution for my problem. My current VBA solution takes me to cell [I6] instead of [L6] and I can't figure out how to edit my code to find the correct cell ([L6] in my example picture).
Dim rngSel As String, rngStart As String
Dim rngActiveStart As Range
rngSel = ActiveCell.Address(0, 0)
rngStart = Cells(ActiveCell.Row, 1).Address(0, 0)
Set rngActiveStart = Range(rngStart & ":" & rngSel)
Dim c
For Each c In rngActiveStart.Cells
If c <> Target.Value And c.Offset(0, 1) = Target.Value Then
c.Select
MsgBox "Previous different cell: " & c.Address(0, 0)
Exit For
End If
Next
Using selection_Change
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim r As Long, col As Long, x
Dim v As String
r = Target.Row
v = Target.Value
Application.EnableEvents = False
For x = Target.Column To 1 Step -1
With Me
If .Cells(r, x) <> v Then
.Cells(r, x).Select
Exit For
End If
End With
Next x
Application.EnableEvents = True
End Sub
You need a For i = max To min Step -1 loop to loop backwards/left:
Public Sub MoveLeftUntilChange()
Dim SelRange As Range 'remember the selected range 'N6
Set SelRange = Selection
Dim iCol As Long
For iCol = SelRange.Column To 1 Step -1 'move columns leftwards
With SelRange.Parent.Cells(SelRange.Row, iCol) 'this is the current row/column to test againts the remembered range N6
If .Value <> SelRange.Value Then 'if change found select and exit
.Select
Exit For
End If
End With
Next iCol
End Sub
I am attempting to write code to enter in next available row a value of 1 when a checkbox is checked and value of 0 if unchecked.
Private Sub CheckBox2_Click()
If CheckBox2.Value = True Then
Set LastRow = Sheet9.Range("a70000").End(xlUp)
LastRow.Offset(1, 2).Value = 1
End If
If CheckBox2.Value = False Then
LastRow.Offset(1, 2).Value = 0
End If
End Sub
Private Sub enterMDGfunction_Click()
Dim LastRow As Object
Set LastRow = Sheet9.Range("a70000").End(xlUp)
Unload Me
DataEntrySystemHomepage.Show
End Sub
Currently it wont enter into next available row. After one entry the datasheet stops populating. Does it have to do with my unload form code?
Set LastRow = Sheet9.Range("a70000").End(xlUp)
LastRow.Offset(1, 2).Value = 1
This enters a value one row down from LastRow, in Col C, but because you never put anything new in Col A, the next time you get LastRow it will again return the same cell in ColA as previously.
Either put something in Col A, or perform the end(xlup) from Col C
With a bit of re-work it's simpler as:
Private Sub CheckBox2_Click()
Sheet9.Range("C70000").End(xlUp).Offset(1, 0).Value = _
IIf(CheckBox2.Value, 1, 0)
End Sub
I am trying to create an audit trail DB, and have the managed to formulate some code to take each line to sheet 2, however I have fallen at the last and cannot work out how to paste values only?
here is my code thus far; any help greatly appreciated
Private Sub Worksheet_Change(ByVal Target As Range)
Dim nxtRow As Integer, b As Boolean
'Determine if change was to Column I (9)
If Target.Column = 9 Then
'If Yes, Determine if cell >= 1
If IsError(Target.Value) Then
b = True
Else
If Target.Value >= 1 Then
b = True
Else
b = False
End If
End If
If b Then
'If Yes, find next empty row in Sheet 2
nxtRow = Sheets(2).Range("A" & Rows.Count).End(xlUp).Row + 1
'Copy changed row and paste into Sheet 2
Target.EntireRow.Copy _
Destination:=Sheets(2).Range("A" & nxtRow)
End If
End If
End Sub
Thanks
Matt
To paste values, you can copy to the clipboard then use the PasteSpecial method, for example:
Target.EntireRow.Copy
Sheets(2).Range("A" & nxtRow).PasteSpecial Paste:=xlPasteValues
This might not solve the problem but it will improve your code.
you open some If-statements but you don't close some which will make your code do something else than you want.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim nxtRow As Integer, b As Boolean
'Determine if change was to Column I (9)
If Target.Column = 9 Then
'If Yes, Determine if cell >= 1
If IsError(Target.Value) Then ' You open this If but you don't close it
b = True
'if you don't close it here the next line (else) will be the else of this if
End If
Else
If Target.Value >= 1 Then
b = True
Else
b = False
End If
'this line had an else if as well. which would just stop your main if statement
If b = True Then
'you say 'if b then' on the line above, which basically does nothing
'If you want to check if b = True for example, do what I did above
'If Yes, find next empty row in Sheet 2
nxtRow = Sheets(2).Range("A" & Rows.Count).End(xlUp).Row + 1
'Copy changed row and paste into Sheet 2
Target.EntireRow.Copy _
Destination:=Sheets(2).Range("A" & nxtRow)
End If
End If
End Sub