Sub test()
Dim lr As Long
    With Sheets("продукт")
        lr = .Cells(3, 2).Value + 4
        Set fn = Application.WorksheetFunction
        For r = 5 To lr
            .Cells(r, 4).Formula = fn.SumIfs([procJanV], [procChainV], .Cells(r, 2), [procBrandV], .Cells(r, 3))
        Next r
    End With
End Sub

Option Explicit
Public WithEvents eBx1 As MSForms.TextBox
Public WithEvents eBx2 As MSForms.TextBox
...
до Public WithEvents eBx50 As MSForms.TextBox


Private Sub eBx1_Change()
With Application
    .EnableEvents = False
    .ScreenUpdating = False
End With
    If eBx1.Tag = "" Then Exit Sub
    Dim lc1 As Long, lc2 As Long, r As Integer, Str
    Str = Split(eBx1.Tag, ";")
    If UBound(Str) < 1 Then Exit Sub
    lc1 = val(Str(0))
    lc2 = val(Str(1))
    With Worksheets("updateEvent")
        If .Cells(5, 2).Value = .Cells(1, 1).Value Then
            .Cells(3, lc1).Value = Format(val(eBx1.Value) / 100, "#0%")
        Else
            .Cells(3, lc2).Value = Format(val(eBx1.Value) / 100, "#0%")
        End If
    End With
    With eBx1
        If Not IsNumeric(.Text) And .Text <> "" Then
            .Text = Left(.Text, Len(.Text) - 1)
            .SelStart = Len(.Text)
        End If
    End With
With Application
    .EnableEvents = True
    .ScreenUpdating = True
End With
End Sub

Private Sub eBx2_Change()
With Application
    .EnableEvents = False
    .ScreenUpdating = False
End With
    If eBx2.Tag = "" Then Exit Sub
    Dim lc1 As Long, lc2 As Long, r As Integer, Str
    Str = Split(eBx2.Tag, ";")
    If UBound(Str) < 1 Then Exit Sub
    lc1 = val(Str(0))
    lc2 = val(Str(1))
    With Worksheets("updateEvent")
        If .Cells(5, 2).Value = .Cells(1, 1).Value Then
            .Cells(4, lc1).Value = Format(val(eBx2.Value) / 100, "#0%")
        Else
            .Cells(4, lc2).Value = Format(val(eBx2.Value) / 100, "#0%")
        End If
    End With
    With eBx2
        If Not IsNumeric(.Text) And .Text <> "" Then
            .Text = Left(.Text, Len(.Text) - 1)
            .SelStart = Len(.Text)
        End If
    End With
With Application
    .EnableEvents = True
    .ScreenUpdating = True
End With
End Sub
...
до Private Sub eBx50_Change()

'function for import data from eventsFC to sheet
Dim eVal1() As New eventFC 'название Class Molude
Dim eVal2() As New eventFC
...
до Dim eVal50() As New eventFC
Private Sub UserForm_Initialize()
Application.EnableEvents = False
Application.ScreenUpdating = False
    Dim c, r As Integer
    If Sheets("updateEvent").Cells(1, 2).Value = "New" Then
    Else
        ReDim eVal1(1 To 12)
            For c = 1 To 12
               Set eVal1(c).eBx1 = eventsFC.frmEvent.Controls("txtBrand1_" & c)
            Next c
        ReDim eVal2(1 To 12)
            For c = 1 To 12
               Set eVal2(c).eBx2 = eventsFC.frmEvent.Controls("txtBrand2_" & c)
            Next c
...
до 
        ReDim eVal50(1 To 12) 
           For c = 1 To 12
               Set eVal50(c).eBx50 = eventsFC.frmEvent.Controls("txtBrand50_" & c)
            Next c
    End If
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

Private Sub txtUfcProd1_1_Change()
    If Worksheets("updatingFC").Cells(5, 2).Value = Worksheets("updatingFC").Cells(1, 1).Value Then
        Worksheets("updatingFC").Cells(3, 37).Value = txtUfcProd1_1.Value
    Else
        Worksheets("updatingFC").Cells(3, 49).Value = txtUfcProd1_1.Value
    End If
End Sub

Private Sub txtUfcProd1_2_Change()
    If Worksheets("updatingFC").Cells(5, 2).Value = Worksheets("updatingFC").Cells(1, 1).Value Then
        Worksheets("updatingFC").Cells(3, 38).Value = txtUfcProd1_2.Value
    Else
        Worksheets("updatingFC").Cells(3, 50).Value = txtUfcProd1_2.Value
    End If
End Sub

Private Sub txtUfcProd1_3_Change()
    If Worksheets("updatingFC").Cells(5, 2).Value = Worksheets("updatingFC").Cells(1, 1).Value Then
        Worksheets("updatingFC").Cells(3, 39).Value = txtUfcProd1_3.Value
    Else
        Worksheets("updatingFC").Cells(3, 51).Value = txtUfcProd1_3.Value
    End If
End Sub

Private Sub txtUfcProd1_4_Change()
    If Worksheets("updatingFC").Cells(5, 2).Value = Worksheets("updatingFC").Cells(1, 1).Value Then
        Worksheets("updatingFC").Cells(3, 40).Value = txtUfcProd1_4.Value
    Else
        Worksheets("updatingFC").Cells(3, 52).Value = txtUfcProd1_4.Value
    End If
End Sub

Private Sub txtUfcProd1_5_Change()
    If Worksheets("updatingFC").Cells(5, 2).Value = Worksheets("updatingFC").Cells(1, 1).Value Then
        Worksheets("updatingFC").Cells(3, 41).Value = txtUfcProd1_5.Value
    Else
        Worksheets("updatingFC").Cells(3, 53).Value = txtUfcProd1_5.Value
    End If
End Sub

Private Sub txtUfcProd1_6_Change()
    If Worksheets("updatingFC").Cells(5, 2).Value = Worksheets("updatingFC").Cells(1, 1).Value Then
        Worksheets("updatingFC").Cells(3, 42).Value = txtUfcProd1_6.Value
    Else
        Worksheets("updatingFC").Cells(3, 54).Value = txtUfcProd1_6.Value
    End If
End Sub

Private Sub txtUfcProd1_7_Change()
    If Worksheets("updatingFC").Cells(5, 2).Value = Worksheets("updatingFC").Cells(1, 1).Value Then
        Worksheets("updatingFC").Cells(3, 42).Value = txtUfcProd1_7.Value
    Else
        Worksheets("updatingFC").Cells(3, 54).Value = txtUfcProd1_7.Value
    End If
End Sub
...

Sub select_last_3_days()
Application.ScreenUpdating = False
Dim StartDate As Date
Dim EndDate As Date

StartDate = Sheets("analytics").Range("AC2").Value
EndDate = Sheets("analytics").Range("AD2").Value
    
    With Worksheets("analytics").PivotTables("PivotTable3").PivotFields("HistoryUpdateDate")
        .ClearAllFilters
        .PivotFilters.Add Type:=xlDateBetween, Value1:=StartDate, Value2:=EndDate
    End With

Application.ScreenUpdating = True
End Sub
 

...     
With Worksheets("analytics").PivotTables("PivotTable3").PivotFields("companyName")
        .ClearAllFilters
        .PivotFilters.Add2 Type:=xlValueIsLessThan, DataField:=Worksheets("analytics").PivotTables( _
        "PivotTable3").PivotFields("Sum of AvPrice"), Value1:=Sheets("Dashboard").Range("B8").Value
End With
 ...

Private Sub UserForm1_Activate()
    TextBox1.Value = Worksheets("Sheet1").Range("C37").Value
End Sub

.... 
 
   With Sheets("array") 
      ......
            .Range("D2", .Range("D2").End(xlDown)).Replace What:="р.", Replacement:="" 
      ......
       End With
 ....

Sub TestCopy()
PastRow1 = Sheets("Sheet2").Range("A65536").End(xlUp).Row + 1
    With Sheets("Sheet1")
        .Range (.Cells(1, 1)), .Range(.Cells(1, 3), .Cells(1, 5)).Copy
        Sheets("Sheet2").Range("A" & PastRow1).PasteSpecial xlPasteValues
    End With
End Sub
 

Sub x()
Dim rng As Range
Dim FirstRow As Long
For FirstRow = 5 To 683 Step 3
   Sheets("Sheet1").Range(Cells(FirstRow, 1), Cells(FirstRow, 5)).Copy
Next FirstRow
End Sub

Sub select_array()
    With Sheets("Sheet1")
        .Range("V3", .Cells(.Range("V3").End(xlDown).Row, .Range("V3").End(xlToRight).Column)).Select
    End With
End Sub
 

Sub select()
    Sheets("Array").Range("V3", Cells(Range("V3").End(xlDown).Row, Range("V3").End(xlToRight).Column)).ClearContents 'удалить значение
    beg = 0
    For Each cell In Sheets("Array").Range("S8:S" & Cells(Rows.Count, 11).End(xlUp).Row)
        If cell > 0 And cell <= 3 Then
            If beg = 0 Then beg = cell.Row
            fin = cell.Row
        End If
    Next
    Sheets("ArrayMap").Range("K" & beg & ":T" & fin).Copy
    Sheets("ArrayMap").Range("V3").PasteSpecial Paste:=xlPasteValues
    Sheets("ArrayMap").Range("V:AE").Sort Key1:=Range("AE3"), Order1:=xlDescending, Header:=xlYes
End Sub
 

Sub select_all()
    Range("A4", Cells(Range("B4").End(xlDown).Row, Range("A4").End(xlToRight).Column)).Select
End Sub
 

'добавить значение
Sub AddText(Optional fnt As Integer = 20, Optional tp As String = "number")
'удалить старых значений
    Call DellText
    Dim Ctr As Integer
    Dim myRng As Range
    Dim r As Integer
    Dim shpsArr(88) As String
    Dim x As Integer
    Set myRng = ThisWorkbook.Names("regText").RefersToRange
    For r = 1 To myRng.Count
        Dim l As Integer
        Dim t As Integer
        Dim s As Integer
        Dim regId As String
        Dim nshp As Shape
        Dim cPnt As RegionCenterPoint
        regId = myRng(r).Offset(0, -1).Value
        Set cPnt = cPointRussia("Buble_" & regId)
        s = 20
        l = cPnt.Left - s * 0.5
        t = cPnt.Top - s * 0.5
        Set nshp = ThisWorkbook.Sheets("Map").Shapes.AddTextbox(msoTextOrientationHorizontal, l, t, s, s)
        'форматирую фигуру
        With nshp
            .Name = "NewText_" & regId
            .Fill.Visible = msoFalse
            .Line.Visible = msoFalse
            .TextFrame2.VerticalAnchor = msoAnchorMiddle
            .TextFrame2.HorizontalAnchor = msoAnchorNone
            .TextFrame2.AutoSize = msoAutoSizeNone
            .TextFrame2.TextRange.Font.Size = fnt
            .TextFrame2.WordWrap = msoFalse
            .TextFrame2.TextRange.ParagraphFormat.Alignment = msoAlignCenter
            .ZOrder msoBringToFront
        End With
        'подписываю
        Select Case tp
        Case "n"
            nshp.TextFrame2.TextRange.Characters.text = regId
        Case "t"
            nshp.TextFrame2.TextRange.Characters.text = myRng(r).Value
        End Select
        'заношу фигуру в массив
        shpsArr(x) = nshp.Name
        x = x + 1
    Next r
    Dim grp As Shape
    Set grp = ThisWorkbook.Sheets("Map").Shapes.Range(shpsArr).Group
    grp.Name = "gr_Text"
    grp.ZOrder msoBringToFront
End Sub
 

Private Sub ComboBox6_Change()
    If ComboBox6.Value = "Distr_1" Or ComboBox6.Value = "Distr_2" Or ComboBox6.Value = "Distr_3" Or _
    ComboBox6.Value = "Distr_4" Or ComboBox6.Value = "Distr_5" Or ComboBox6.Value = "Distr_6" Or ComboBox6.Value = "Distr_7" Then
       Call DellBuble
       Call DellText
       OptionButton1.Value = False
       OptionButton3.Value = False
       OptionButton4.Value = False
       OptionButton5.Value = False
       OptionButton6.Value = False
       OptionButton7.Value = False
       OptionButton8.Value = False
    End If
End Sub 

Option Explicit
'константы
Const gr_South As String = "shape_region_01;shape_region_23"

'Show Form
Sub ShowForm()
    frm_main.Show
End Sub

'добавить код региона
Sub AddText_Southern(Optional fnt As Integer = 20, Optional tp As String = "number")
'удалить код региона
    Call DellText_Southern
    Dim Ctr As Integer
    Dim myRngSouthern As Range
    Dim r As Integer
    Dim shpsArr(6) As String
    Dim x As Integer
    Set myRngSouthern = ThisWorkbook.Names("regText_Southern").RefersToRange
    For r = 1 To myRngSouthern.Count
        Dim l As Integer
        Dim t As Integer
        Dim s As Integer
        Dim regId As String
        Dim nshp As Shape
        Dim cPnt As RegionCenterPoint
        regId = myRngSouthern(r).Offset(0, -1).Value
        Set cPnt = cPointSouthern("Buble_" & regId)
        s = 20
        l = cPnt.Left - s * 0.5
        t = cPnt.Top - s * 0.5
        Set nshp = ThisWorkbook.Sheets("Map").Shapes.AddTextbox(msoTextOrientationHorizontal, l, t, s, s)
        'форматировать фигуру
        With nshp
            .Name = "NewText_" & regId
            .Fill.Visible = msoFalse
            .Line.Visible = msoFalse
            .TextFrame2.VerticalAnchor = msoAnchorMiddle
            .TextFrame2.HorizontalAnchor = msoAnchorNone
            .TextFrame2.AutoSize = msoAutoSizeNone
            .TextFrame2.TextRange.Font.Size = fnt
            .TextFrame2.WordWrap = msoFalse
            .TextFrame2.TextRange.ParagraphFormat.Alignment = msoAlignCenter
            .ZOrder msoBringToFront
        End With
        'подписывать номера региона
        Select Case tp
        Case "n"
            nshp.TextFrame2.TextRange.Characters.text = regId
        Case "t"
            nshp.TextFrame2.TextRange.Characters.text = myRngSouthern(r).Value
        End Select
        'заносить фигуру в массив
        shpsArr(x) = nshp.Name
        x = x + 1
    Next r
    Dim grp As Shape
    Set grp = ThisWorkbook.Sheets("Map").Shapes.Range(shpsArr).Group
    grp.Name = "gr_Text"
    grp.ZOrder msoBringToFront
End Sub

'удалить код региона
Sub DellText_Southern()
    Dim shp As Shape
    For Each shp In ActiveSheet.Shapes
        If LCase(shp.Name) Like LCase("*text*") Then
            shp.Delete
        End If
    Next shp
End Sub
 

Option Explicit
Function cPointSouthern(n As String) As RegionCenterPoint
    Dim Buble_01 As New RegionCenterPoint
    Dim Buble_23 As New RegionCenterPoint

    Buble_01.Name = "Buble_01"
    Buble_23.Name = "Buble_23"

    Buble_01.Left = 358
    Buble_23.Left = 400

    Buble_01.Top = 255
    Buble_23.Top = 195

    Dim arrBubles(1) As RegionCenterPoint
    Set arrBubles(0) = Buble_01
    Set arrBubles(1) = Buble_23
    Dim p As Variant
    For Each p In arrBubles()
        If p.Name = n Then
            Set cPointSouthern = p
            Exit For
        End If
    Next p
End Function
 

Private bublName As String
Private bublTop As Integer
Private bublLeft As Integer
Property Let Name(s As String)
    bublName = s
End Property
Property Get Name() As String
    Name = bublName
End Property
Property Let Top(s As Integer)
    bublTop = s
End Property
Property Get Top() As Integer
    Top = bublTop
End Property

Property Get Left() As Integer
    Left = bublLeft
End Property
Property Let Left(s As Integer)
    bublLeft = s
End Property
 

Sub AddText(Optional fnt As Integer = 20, Optional tp As String = "number")

    Call DellText
    Dim Ctr As Integer
    Dim myRng As Range
    Dim r As Integer
    Dim shpsArr(88) As String
    Dim x As Integer
    Set myRng = ThisWorkbook.Names("regText").RefersToRange
    For r = 1 To myRng.Count
        Dim l As Integer
        Dim t As Integer
        Dim s As Integer
        Dim regId As String
        Dim nshp As Shape
        Dim cPnt As RegionCenterPoint
        regId = myRng(r).Offset(0, -5).Value
            If Sheets("Map").Range("D1").Value = "Russia" Then
                Set cPnt = cPointRussia("Buble_" & regId)
            ElseIf Sheets("Map").Range("D1").Value = "Central Federal District" Then
                Set cPnt = cPointCentral("Buble_" & regId)
            End If
        s = 20
        l = cPnt.Left - s * 0.5 'ошибка здесь
        t = cPnt.Top - s * 0.5
        Set nshp = ThisWorkbook.Sheets("Map").Shapes.AddTextbox(msoTextOrientationHorizontal, l, t, s, s)
       
        With nshp
            .Name = "NewText_" & regId
            .Fill.Visible = msoFalse
            .Line.Visible = msoFalse
            .TextFrame2.VerticalAnchor = msoAnchorMiddle
            .TextFrame2.HorizontalAnchor = msoAnchorNone
            .TextFrame2.AutoSize = msoAutoSizeNone
            .TextFrame2.TextRange.Font.Size = fnt
            .TextFrame2.WordWrap = msoFalse
            .TextFrame2.TextRange.ParagraphFormat.Alignment = msoAlignCenter
            .ZOrder msoBringToFront
        End With
       
        Select Case tp
        Case "n"
            nshp.TextFrame2.TextRange.Characters.text = regId
        Case "t"
            nshp.TextFrame2.TextRange.Characters.text = myRng(r).Value
        End Select
      
        shpsArr(x) = nshp.Name
        x = x + 1
    Next r
    Dim grp As Shape
    Set grp = ThisWorkbook.Sheets("Map").Shapes.Range(shpsArr).Group
    grp.Name = "gr_Text"
    grp.ZOrder msoBringToFront
End Sub
 

For Each TempSht In .Worksheets
    If TempSht.Name = "Clients ALL" Then
        Sheets("Clients ALL").Select
        '---my Code 1---
    Else
        Sheets("Clients May-June").Select
        '---my Code 2---
    End If
Next

Sub select_range()
Range(Cells(2, 4), Cells.SpecialCells(xlCellTypeLastCell)).Select
End Sub
 

Sub select_range_2()
Range("D2", Range("E2").End(xlDown).End(xlToRight)).Select
End Sub
 

.............................................. 
With .Workbooks.Open _
                    (Filename:=iPath & iTempFileName, UpdateLinks:=False, ReadOnly:=True)
                    iNumFiles = iNumFiles + 1
                    iNumSheets = ActiveWorkbook.Worksheets.Count   
................................................  
MsgBox "Successfully merged " & iNumSheets & " Sheets! " & iNumFiles & " Workbooks!", vbInformation, "Finally" 
End Sub

    Sheets("1").Select
    Range("B1").Select
    Selection.Copy
    Range("B4", .Range("B4").End(xlDown)).Offset(-1, -1).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    Sheets("2").Select
    Range("B1").Select
    Selection.Copy
    Range("B4", Range("B4").End(xlDown)).Offset(-1, -1).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    Sheets("3").Select
    Range("B1").Select
    Selection.Copy
    Range("B4", Range("B4").End(xlDown)).Offset(-1, -1).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
 

Sub Combine_Sheets()
  
   Dim sh As Worksheet
 
    For Each sh In ActiveWorkbook.Sheets
    Range("B1").Select
    Selection.Copy
    Range("B4", ActiveSheet.Range("B4").End(xlDown)).Offset(-1, -1).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Next  
End Sub