I have the following code (which clears the values in dependent drop downs) in the Sheet2 Code Window
Private Sub Worksheet_Change(ByVal Target As Range)
'Update by Extendoffice 2018/06/04
On Error GoTo ErrorHandler
Application.EnableEvents = False
If Target.Column = 5 And Target.Validation.Type = 3 Then
Target.Offset(0, 1).Value = ""
Target.Offset(0, 2).Value = ""
End If
If Target.Column = 6 And Target.Validation.Type = 3 Then
Target.Offset(0, 1).Value = ""
End If
Application.EnableEvents = True
ErrorHandler:
Application.EnableEvents = True
End Sub
That code worked fine until I added a Button and the following code (which copies the existing row and inserts the selection into a new row) in Module1. Now the Button Event works fine but the Change event doesn't seem to ever fire.
Sub AddRow()
Dim LastRow As Long
Dim NextRow As Long
With Sheet2
LastRow = .Range("B" & .Rows.Count).End(xlUp).Row
NextRow = LastRow + 1
With .Range("B" & LastRow & ":I" & LastRow)
Range("B" & LastRow & ":I" & LastRow).Select
Selection.Copy
Range("B" & NextRow & ":I" & NextRow).Select
Selection.Insert Shift:=xlDown
Range("C" & NextRow & ":I" & NextRow).Select
Selection.Clear
End With
End With
End Sub
Any Suggestions?
Related
I have been wracking my brain over this one for quite a while now, I am trying to automate a work-task tracker as much as possible and I have hit a wall. It is a simple cut and paste macro; but I am trying to add a variable that might be getting thrown off by a formula in my spreadsheet. Basically I'd like the macro to look at column "F" and if it is "Closed" and if Column "G" has "Dec" (or "Jan" etc) then it will cut and paste to the corresponding sheet.
Private Sub CommandButton1_Click()
Dim Check As Range, r As Long, lastrow2 As Long, lastrow As Long, theDate As Date
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.DisplayStatusBar = False
Application.EnableEvents = False
lastrow = Worksheets("Master list").UsedRange.Rows.Count
lastrow2 = Worksheets("Dec").UsedRange.Rows.Count
If lastrow2 = 1 Then lastrow2 = 0
For r = lastrow To 2 Step -1
If Range("F" & r).Value = "Closed" And Range("G" & r).Value = "Dec" Then
Rows(r).Cut Destination:=Worksheets("Dec").Range("A" & lastrow2 + 1) ' And here
lastrow2 = lastrow2 + 1
Else:
End If
Next r
Dim i As Long
Dim DelRange As Range
On Error GoTo Whoa
For i = 1 To 250
If Application.WorksheetFunction.CountA(Range("A" & i & ":" & "Z" & i)) = 0 Then
If DelRange Is Nothing Then
Set DelRange = Rows(i)
Else
Set DelRange = Union(DelRange, Rows(i))
End If
End If
Next i
If Not DelRange Is Nothing Then DelRange.Delete Shift:=xlUp
LetsContinue:
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Exit Sub
Whoa:
MsgBox "Perfectly balanced, as all things should be."
End Sub
Ries
I need that after a userform is submited that row and cells are locked.
When you insert data in userform those data go to tab called "table". I need tab TABLE to be locked and to allow only userform input.
I need rows and cells from A4 to AF4 onwards to be locked for editing.
I tried with this code.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim MyRange As Range
Set MyRange = Intersect(Range("A1:D100"), Target)
If Not MyRange Is Nothing Then
Sheets("Sheet1").Unprotect password:="hello"
MyRange.Locked = True
Sheets("Sheet1").Protect password:="hello"
End If
End Sub
This is how my command button looks
Private Sub CommandButton2_Click()
Dim sh As Worksheet, lastRow As Long
Set sh = Sheets("Details")lastRow = sh.Range("A" & Rows.Count).End(xlUp).row + 1
sh.Range("A" & lastRow).value = TextBox3.value
sh.Range("B" & lastRow).value = TextBox4.Text
sh.Range("C" & lastRow).value = TextBox5.Text
Unload Me
End sub
First, manually lock the cells from A4:AF[ChooseTheLastRow] and then protect the worksheet with a password and do not allow the selecting of locked cells.
Then in your code do this.
Private Sub CommandButton2_Click()
Dim sh As Worksheet
Set sh = Sheets("Details") 'you called this TABLE in your text above, no?
With sh
.unprotect "PASSWORD"
Dim lastRow As Long
lastRow = .Range("A" & Rows.Count).End(xlUp).row + 1
.Range("A" & lastRow).value = TextBox3.value
.Range("B" & lastRow).value = TextBox4.Text
.Range("C" & lastRow).value = TextBox5.Text
.protect "PASSWORD"
End With
End sub
I'm trying (and failing) to get some code to run on each worksheet except one specific sheet. I want the code to just cut the data in cells n2:s2 and paste it in t1:y1, then repeat for any other rows that have data in columns n3:s3, n4:s4, n5:s5.
Once there is no data (row 6 i believe), it should move onto the next sheet (except "Report" sheet).
The problem i'm facing when i debug is it moves the data as expected, then starts again on the same sheet, so overwrites data with empty cells.
Sub MovethroughWB()
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets 'This statement starts the loop
If ws.Name <> "Report" Then 'Perform the Excel action you wish (turn cell yellow below)
Range("N2:S2").Select
Selection.Cut Destination:=Range("T1:Y1")
Range("T1:Y1").Select
Range("N3:S3").Select
Selection.Cut Destination:=Range("Z1:AE1")
End If
Next ws
End Sub
I'm sure its something basic, but can't find what!
Try:
Sub MovethroughWB()
Dim ws As Worksheet
Dim i As Long, Lastrow As Long, Lastcolumn As Long
For Each ws In ThisWorkbook.Worksheets 'This statement starts the loop
If ws.Name <> "Report" Then 'Perform the Excel action you wish (turn cell yellow below)
With ws
Lastrow = .Cells(.Rows.Count, "N").End(xlUp).Row
For i = 2 To Lastrow
If .Range("N" & i).Value <> "" And .Range("O" & i).Value <> "" And .Range("P" & i).Value <> "" _
And .Range("Q" & i).Value <> "" And .Range("R" & i).Value <> "" And .Range("S" & i).Value <> "" Then
If .Range("T1").Value = "" Then
.Range("N" & i & ":S" & i).Cut .Range("T1:Y1")
Else
Lastcolumn = .Cells(1, .Columns.Count).End(xlToLeft).Column + 1
.Range("N" & i & ":S" & i).Cut .Range(.Cells(1, Lastcolumn), .Cells(1, Lastcolumn + 5))
End If
End If
Next i
.Rows("2:" & Lastrow).EntireRow.Delete
End With
End If
Next ws
End Sub
I'm having a problem with a macro because it give me Ambiguous name detected Worksheet_Change . If the user enter a value on any cell under column B it will run automatically a macro and if the user enter a value on column F it will run automatically another macro but I do not know how to fix this error . Please the the code below
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Columns("B")) Is Nothing Then
On Error GoTo Safe_Exit
Application.EnableEvents = False
Dim rng As Range
For Each rng In Intersect(Target, Columns("B"))
If rng.Row > 2 Then ' your sample code seemed to suggest that this should start on row 3 and higher
Call MyMacro(rng.Row)
End If
Next rng
End If
Safe_Exit:
Application.EnableEvents = True
End Sub
Sub MyMacro(rw As Long)
If Range("B" & rw) = "" Then
MsgBox "Ingrese El account Number"
Else
Range("J" & rw & ":K" & rw) = Range("J" & rw & ":K" & rw).Value
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Columns("F")) Is Nothing Then
On Error GoTo Safe_Exit
Application.EnableEvents = False
Dim rng As Range
For Each rng In Intersect(Target, Columns("F"))
If rng.Row > 3 Then ' your sample code seemed to suggest that this should start on row 3 and higher
Call Foolish(rng.Row)
End If
Next rng
End If
Safe_Exit:
Application.EnableEvents = True
End Sub
Sub Foolish(rw As Long)
If Range("F" & rw) = "" Then
MsgBox "Ingrese El account Number"
Else
Range("G" & rw & ":H" & rw) = Range("G" & rw & ":H" & rw).Value
End If
End Sub
You have two Worksheet_change() subs happening in your sheet. Copy the contents of one of those subroutines and paste it inside the other one so there is only one worksheet_change event.
For example:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Columns("B")) Is Nothing Then
On Error GoTo Safe_Exit
Application.EnableEvents = False
Dim rng As Range
For Each rng In Intersect(Target, Columns("B"))
If rng.Row > 2 Then ' your sample code seemed to suggest that this should start on row 3 and higher
Call MyMacro(rng.Row)
End If
Next rng
End If
If Not Intersect(Target, Columns("F")) Is Nothing Then
On Error GoTo Safe_Exit
Application.EnableEvents = False
Dim rng As Range
For Each rng In Intersect(Target, Columns("F"))
If rng.Row > 3 Then ' your sample code seemed to suggest that this should start on row 3 and higher
Call Foolish(rng.Row)
End If
Next rng
End If
Safe_Exit:
Application.EnableEvents = True
End Sub
Sub MyMacro(rw As Long)
If Range("B" & rw) = "" Then
MsgBox "Ingrese El account Number"
Else
Range("J" & rw & ":K" & rw) = Range("J" & rw & ":K" & rw).Value
End If
End Sub
I need to compare values on two separate sheets, both are in column H starting at 2. One sheet is labeled final, the other data. If it is in final and not in data then highlight in final. If something found in data is not in final copy it into final (whole row) at the bottom. It is all text. Column H is titled "Reference".
code 1
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Target.Column <> 8 Then Exit Sub
Dim lastRow As Long
Dim rng As Range, cell As Range
lastRow = Range("H" & Rows.Count).End(xlUp).Row
If lastRow < 2 Then lastRow = 2
Set rng = Range("H2:H" & lastRow)
For Each cell In rng
With Sheets("data")
a = Application.VLookup(cell.Value, .Range("H2:H" & .Range("H" & Rows.Count).End(xlUp).Row), 1, 0)
If IsError(a) Then
cell.Interior.Color = vbYellow
Else
cell.Interior.Color = xlNone
End If
End With
Next
Application.EnableEvents = True
End Sub
code 2
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Target.Column <> 8 Then Exit Sub
Dim lastRow As Long
Dim rng As Range, cell As Range
lastRow = Range("H" & Rows.Count).End(xlUp).Row
If lastRow < 2 Then lastRow = 2
Set rng = Range("H2:H" & lastRow)
For Each cell In rng
With Sheets("final")
a = Application.VLookup(cell.Value, .Range("H2:H" & .Range("H" & Rows.Count).End(xlUp).Row), 1, 0)
If IsError(a) Then
cell.Copy .Range("H" & .Range("H" & Rows.Count).End(xlUp).Row)
End If
End With
Next
Application.EnableEvents = True
End Sub