Thanks for your great tips.
How can I merge these two VBA codes?
1- Following code is related to multiple selection in a drop-down menu without repeating the selection:
VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
'Updated by Extendoffice 2019/11/13
Dim xRng As Range
Dim xValue1 As String
Dim xValue2 As String
If Target.Count > 1 Then Exit Sub
On Error Resume Next
Set xRng = Cells.SpecialCells(xlCellTypeAllValidation)
If xRng Is Nothing Then Exit Sub
Application.EnableEvents = False
If Not Application.Intersect(Target, xRng) Is Nothing Then
xValue2 = Target.Value
Application.Undo
xValue1 = Target.Value
Target.Value = xValue2
If xValue1 <> "" Then
If xValue2 <> "" Then
If xValue1 = xValue2 Or _
InStr(1, xValue1, "¡ " & xValue2) Or _
InStr(1, xValue1, xValue2 & ",") Then
Target.Value = xValue1
Else
Target.Value = xValue1 & "¡ " & xValue2
End If
End If
End If
End If
Application.EnableEvents = True
End Sub
2- This code is also related to the filter that you took the trouble to write for me, and I manipulated it to apply 3 filters on 3 columns of data.
VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("D1")) Is Nothing Then Filter_namebakhsh Range("D1").Value
If Not Intersect(Target, Range("F1")) Is Nothing Then Filter_saleshoroo Range("F1").Value
If Not Intersect(Target, Range("H1")) Is Nothing Then Filter_salekhatameh Range("H1").Value
End Sub
The relevant codes in the module are as follows:
VBA Code:
Sub Filter_namebakhsh(namebakhsh As String)
Application.Calculation = xlCalculationManual
With Worksheets("Projects")
.AutoFilterMode = False
If Len(namebakhsh) > 0 Then .Range("A1:AQ" & .Cells(.Rows.Count, "AC").End(xlUp).Row).AutoFilter Field:=29, Criteria1:=namebakhsh
End With
Application.Calculation = xlCalculationAutomatic
Worksheets("Keywords Analysis").Activate
ActiveSheet.PivotTables("PivotTable2").RefreshTable
End Sub
Sub Filter_saleshoroo(saleshoroo As String)
Application.Calculation = xlCalculationManual
With Worksheets("Projects")
.AutoFilterMode = False
If Len(saleshoroo) > 0 Then .Range("A1:AQ" & .Cells(.Rows.Count, "AF").End(xlUp).Row).AutoFilter Field:=32, Criteria1:=">=" & saleshoroo
End With
Application.Calculation = xlCalculationAutomatic
Worksheets("Keywords Analysis").Activate
ActiveSheet.PivotTables("PivotTable2").RefreshTable
End Sub
Sub Filter_salekhatameh(salekhatameh As String)
Application.Calculation = xlCalculationManual
With Worksheets("Projects")
.AutoFilterMode = False
If Len(salekhatameh) > 0 Then .Range("A1:AQ" & .Cells(.Rows.Count, "AG").End(xlUp).Row).AutoFilter Field:=33, Criteria1:="<=" & salekhatameh
End With
Application.Calculation = xlCalculationAutomatic
Worksheets("Keywords Analysis").Activate
ActiveSheet.PivotTables("PivotTable2").RefreshTable
End Sub
thank you