On module
Sub FIllRankProject(Niederlassung As String, Amount As Integer, ws As Worksheet)
Worksheets("ValuesG").Select
ActiveWorkbook.Worksheets("ValuesG").ListObjects("PQ_ProjektContr_G") _
.Sort.SortFields.Clear
'ActiveSheet.ShowAllData
ActiveSheet.ListObjects("PQ_ProjektContr_G").Range.AutoFilter Field:=3, _
Criteria1:=Niederlassung
ActiveWorkbook.Worksheets("ValuesG").ListObjects("PQ_ProjektContr_G") _
.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("ValuesG").ListObjects("PQ_ProjektContr_G") _
.Sort.SortFields.Add Key:=Range("PQ_ProjektContr_G[[#All],[FY2020]]"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("ValuesG").ListObjects( _
"PQ_ProjektContr_G").Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Dim rng As Range
Set rng = Worksheets("ValuesG").Range("PQ_ProjektContr_G[FY2020]")
Dim ProjectCounter As Integer
For Each cl In rng
If cl.EntireRow.Hidden = False Then
ws.Cells(122 + ProjectCounter, 2) = cl.Row
ProjectCounter = ProjectCounter + 1
If ProjectCounter = Amount Then Exit For
End If
Next
ws.Select
End Sub
on sheet
Private Sub Worksheet_Change(ByVal Target As Range) 'Excel VBA with more cells in the range.
If Not Intersect(Target, Range("E4")) Is Nothing Then
Dim lastCell As Range
Set lastCell = ActiveSheet.Cells(Rows.Count, "A").End(xlUp)
ActiveSheet.Range("B" & 122 & ":B200").Value = ""
Call FIllRankProject(Target.Value, lastCell.Value, ActiveSheet)
End If
End Sub
Sub FIllRankProject(Niederlassung As String, Amount As Integer, ws As Worksheet)
Worksheets("ValuesG").Select
ActiveWorkbook.Worksheets("ValuesG").ListObjects("PQ_ProjektContr_G") _
.Sort.SortFields.Clear
'ActiveSheet.ShowAllData
ActiveSheet.ListObjects("PQ_ProjektContr_G").Range.AutoFilter Field:=3, _
Criteria1:=Niederlassung
ActiveWorkbook.Worksheets("ValuesG").ListObjects("PQ_ProjektContr_G") _
.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("ValuesG").ListObjects("PQ_ProjektContr_G") _
.Sort.SortFields.Add Key:=Range("PQ_ProjektContr_G[[#All],[FY2020]]"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("ValuesG").ListObjects( _
"PQ_ProjektContr_G").Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Dim rng As Range
Set rng = Worksheets("ValuesG").Range("PQ_ProjektContr_G[FY2020]")
Dim ProjectCounter As Integer
For Each cl In rng
If cl.EntireRow.Hidden = False Then
ws.Cells(122 + ProjectCounter, 2) = cl.Row
ProjectCounter = ProjectCounter + 1
If ProjectCounter = Amount Then Exit For
End If
Next
ws.Select
End Sub
on sheet
Private Sub Worksheet_Change(ByVal Target As Range) 'Excel VBA with more cells in the range.
If Not Intersect(Target, Range("E4")) Is Nothing Then
Dim lastCell As Range
Set lastCell = ActiveSheet.Cells(Rows.Count, "A").End(xlUp)
ActiveSheet.Range("B" & 122 & ":B200").Value = ""
Call FIllRankProject(Target.Value, lastCell.Value, ActiveSheet)
End If
End Sub