I have two BeforeDoublceClick events which i need help amalgamating, please can someone help me?
I want to amalgamate
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Column <> 1 Then Exit Sub
Dim last As Long
last = Sheet2.Cells(Rows.Count, "A").End(xlUp).Row
Sheet2.Range("A6:P" & last).AutoFilter
Sheet2.Range("A6:P" & last).AutoFilter Field:=1, Criteria1:=Target.Value
Cancel = True
Application.Goto Sheet2.Range("A1")
End Sub
and
If Target.Column <> 2 Then Exit Sub
Dim last As Long
last = Sheet1.Cells(Rows.Count, "B").End(xlUp).Row
Sheet1.Range("A6:AQ" & last).AutoFilter
Sheet1.Range("B6:AQ" & last).AutoFilter Field:=1, Criteria1:=Target.Value
Cancel = True
Application.Goto Sheet1.Range("B7")
End Sub
The two codes are basically the same except the goto at the end, right?
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not (Target.Column = 1 Or Target.Column = 2) Then Exit Sub
Dim last As Long
last = Sheet1.Cells(Rows.Count, "B").End(xlUp).Row
Sheet1.Range("A6:AQ" & last).AutoFilter
Sheet1.Range("A6:AQ" & last).AutoFilter Field:=1, Criteria1:=Target.Value
Cancel = True
If Target.Column = 1 Then
Application.Goto Sheet1.Range("A1")
Else
Application.goto Sheet1.range("B7")
End if
End Sub
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim last As Long
If Target.Column = 1 Then
last = Me.Cells(Me.Rows.Count, "B").End(xlUp).Row
Me.Range("A6:AQ" & last).AutoFilter
Me.Range("A6:AQ" & last).AutoFilter Field:=1, Criteria1:=Target.Value
Cancel = True
Application.Goto Me.Range("A1")
ElseIf Target.Column = 2 Then
last = Me.Cells(Me.Rows.Count, "B").End(xlUp).Row
Me.Range("A6:AQ" & last).AutoFilter
Me.Range("B6:AQ" & last).AutoFilter Field:=1, Criteria1:=Target.Value
Cancel = True
Application.Goto Sheet1.Range("B7")
End If
End Sub
Related
I am working on Excel sheet in which I want to filter many columns together. For example, I have columns from B to G and there are data validations lists on the first cell of each columns to select. I made the code when we select the data the column changes. When I apply the same on the next column, I get the data on the second column, but it removes the filter on the first column. What I want is to process filters on all columns together,
Here is my code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lastrow As Long
lastrow = Cells(Rows.Count, "C").End(xlUp).Row
With Me
If Not Intersect(Target, .Range("B1")) Is Nothing Then
If Target.Value <> "" Then
.AutoFilterMode = False
.Range("B2:B" & lastrow).AutoFilter Field:=1, Criteria1:=Target.Value
End If
End If
If Not Intersect(Target, .Range("C1")) Is Nothing Then
If Target.Value <> "" Then
.AutoFilterMode = False
.Range("C2:C" & lastrow).AutoFilter Field:=1, Criteria1:=Target.Value
End If
End If
End With
End Sub
What I need to do to make the two filters work together.
I think you want this:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lastrow As Long
Dim rCriteria As Range
Dim i As Long
lastrow = Cells(Rows.Count, "C").End(xlUp).Row
With Me
Set rCriteria = .Range("B1:C1")
If Not Intersect(Target, rCriteria) Is Nothing Then
.AutoFilterMode = False
For i = 1 To rCriteria.Count
If rCriteria(i) <> "" Then
.Range("B2:C" & lastrow).AutoFilter Field:=i, Criteria1:=rCriteria(i)
End If
Next
End If
End With
End Sub
I have data that shows Name in a column, then different numbers in the other columns. When I double click on a header cell, it sorts the column in a descending order. This works but then all the names aren't matching up with its value anymore and I can't figure out why.
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim KeyRange As Range
Dim ColumnCount As Integer
Dim lrow As Long
lrow = Sheets("Tracker").Cells(Rows.Count, "B").End(xlUp).Row
On Error Resume Next
ColumnCount = Range("B5:Q" & lrow).Columns.Count
Cancel = False
If Target.Row = 5 And Target.Column <= ColumnCount Then
Cancel = True
Worksheets("Backend").Range("C1") = Target.Value
Set KeyRange = Range(Target.Address)
Range("B5:Q" & lrow).sort Key1:=KeyRange, Header:=xlYes, Order1:=xlDescending
Worksheets("Backend").Range("A1") = Target.Column
Worksheets("Backend").Calculate
For i = 1 To ColumnCount
Range("B5:Q" & lrow).Cells(1, i).Value = Worksheets("Backend").Range("A4").Offset(0, i - 1).Value
Next i
End If
On Error GoTo 0
End Sub
The issue was not with the code but with the formulas within the table.
See: https://answers.microsoft.com/en-us/msoffice/forum/all/index-match-breaks-when-sorting/c848e231-9e53-4a8d-a5f6-f4bf1b9f0a12
You did not include the names column in the range to be sorted.
You have
Range("B5:Q" & lrow).sort Key1:=KeyRange, Header:=xlYes, Order1:=xlDescending
But it should be
Range("A5:Q" & lrow).sort Key1:=KeyRange, Header:=xlYes, Order1:=xlDescending
Edit 1:
Since Names is in column B, not A as I assumed then maybe multiple sorting are being applied over each other. To eliminate this probability, please try sorting using the sheet object instead of the range object (after clearing old sorting).
This is how
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim KeyRange As Range
Dim ColumnCount As Integer
Dim lrow As Long
lrow = Sheets("Tracker").Cells(Rows.Count, "B").End(xlUp).Row
On Error Resume Next
ColumnCount = Range("B5:Q" & lrow).Columns.Count
Cancel = False
If Target.Row = 5 And Target.Column <= ColumnCount Then
Cancel = True
Worksheets("Backend").Range("C1") = Target.Value
With Me
.Sort.SortFields.Clear
.SortFields.Add2 Key:=Target, SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
.Sort.SetRange .Range("B5:Q" & lrow)
.Sort.Header = xlYes
.Sort.MatchCase = False
.Sort.Orientation = xlTopToBottom
.Sort.SortMethod = xlPinYin
.Sort.Apply
End With
With Worksheets("Backend")
.Range("A1") = Target.Column
.Calculate
For i = 1 To ColumnCount
Range("B5:Q" & lrow).Cells(1, i).Value = .Range("A4").Offset(0, i - 1).Value
Next i
End With
End If
On Error GoTo 0
End Sub
I would like to move an entire row to the bottom of a spread sheet if the column k contains a 0. The code I have only works on change not on activate or even better yet with a button. How would i modify the code to work outside of on change?
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
Dim rw As Long
Application.EnableEvents = False
If Not Intersect(Target, Range("K:K")) Is Nothing And LCase(Target) = 0 Then
rw = Target.Row
Target.EntireRow.Cut Cells(Rows.Count, 1).End(xlUp)(2)
Rows(rw).Delete
End If
Application.EnableEvents = True
End Sub
I know you have an answer, but since your wanted to Sort also, this code works.
Sub SortMoveRowstolRow()
Dim fRow As Long, lRow As Long
With Range("A1").CurrentRegion
.Sort Key1:=Range("K1"), Order1:=xlAscending, Header:=xlNo
fRow = .Range("K:K").Find(what:=0, after:=.Range("K1"), Lookat:=xlWhole, searchdirection:=xlPrevious).Row
End With
Rows(1 & ":" & fRow).EntireRow.Cut Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
Rows(1 & ":" & fRow).EntireRow.Delete
End Sub
Try:
Option Explicit
Sub test()
Dim Lastrow As Long, i As Long
With ThisWorkbook.Worksheets("Sheet1")
Lastrow = .Cells(.Rows.Count, "K").End(xlUp).Row
For i = Lastrow - 1 To 1 Step -1
If .Range("K" & i).Value = 0 Then
Lastrow = .Cells(.Rows.Count, "K").End(xlUp).Row
.Rows(i).Cut .Rows(Lastrow + 1)
.Rows(i).EntireRow.Delete
End If
Next i
End With
End Sub
I have two Worksheet_Change event subs that work perfectly on their own, however I need to combine these to test the conditions of either of two ranges "G2" or G3". I have tried all the options in search, but just cannot get this to work. I would appreciate any assistance or advise.
Below are the two Subs:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("G2")) Is Nothing Then Exit Sub
If Target.Count > 1 Then Exit Sub
Dim lr As Long
lr = Range("B" & Rows.Count).End(xlUp).Row
Application.ScreenUpdating = False
Range("Z7:Z" & lr) = "=ISERROR(MATCH(G$2,B7:O7,0))"
Range("Z7", Range("Z" & Rows.Count).End(xlUp)).AutoFilter 1, False
Application.ScreenUpdating = True
Call activate_button_31
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("G3")) Is Nothing Then Exit Sub
If Target.Count > 1 Then Exit Sub
Dim lr As Long
lr = Range("B" & Rows.Count).End(xlUp).Row
Application.ScreenUpdating = False
Range("Q7:Q" & lr) = "=ISERROR(MATCH(G$3,B7:O7,0))"
Range("Q7", Range("Q" & Rows.Count).End(xlUp)).AutoFilter 1, False
Application.ScreenUpdating = True
Call activate_button_40
End Sub
Please let me know should you require any further information.
Kind Regards
Coenie
Try this:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
Dim lr As Long
lr = Range("B" & Rows.Count).End(xlUp).row
Application.ScreenUpdating = False
If Not Intersect(Target, Range("G2")) Is Nothing Then
Range("Z7:Z" & lr) = "=ISERROR(MATCH(G$2,B7:O7,0))"
Range("Z7", Range("Z" & Rows.Count).End(xlUp)).AutoFilter 1, False
Call activate_button_31
ElseIf Not Intersect(Target, Range("G3")) Is Nothing Then
Range("Q7:Q" & lr) = "=ISERROR(MATCH(G$3,B7:O7,0))"
Range("Q7", Range("Q" & Rows.Count).End(xlUp)).AutoFilter 1, False
Call activate_button_40
End If
Application.ScreenUpdating = True
End Sub
One way to combine the routines:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lr As Long
On Error GoTo Terminate
If Target.Count > 1 Then GoTo Terminate
xlQuiet True
lr = Range("B" & Rows.Count).End(xlUp).Row
If Not Intersect(Target, Range("G2")) Is Nothing Then
With Range("Z7:Z" & lr)
.Formula = "=ISERROR(MATCH(G$2,B7:O7,0))"
.AutoFilter 1, False
End With
xlQuiet False
Call activate_button_31
ElseIf Not Intersect(Target, Range("G3")) Is Nothing Then
With Range("Q7:Q" & lr)
.Formula = "=ISERROR(MATCH(G$3,B7:O7,0))"
.AutoFilter 1, False
End With
xlQuiet False
Call activate_button_40
End If
Terminate:
If err Then
Debug.Print "Error", err.Number, err.Description
err.clear
End If
xlQuiet False
End Sub
Private Sub xlQuiet(Optional ByVal b As Boolean)
With Application
.ScreenUpdating = Not b
.EnableEvents = Not b
End With
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