Sub CreateCSV()
    Const sDEL As String = "~"  
    Dim rngData As Range, vData As Variant
    Dim strMyFile As String
    Dim i As Long, j As Long
    Dim lRows As Long, lCols As Long
    
    Set rngData = ActiveSheet.Range("A1").CurrentRegion
    vData = rngData.Value
    lRows = UBound(vData, 1)
    lCols = UBound(vData, 2)
    
    strMyFile = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\" & ActiveSheet.Name & ".csv"
    
    Open strMyFile For Output As #1
        For i = 1 To lRows
            For j = 1 To lCols
                vData(i, 1) = vData(i, 1) & sDEL & vData(i, j)
            Next j
            Print #1, vData(i, 1)
        Next i
    Close #1
End Sub

Sub CreateCSV() 'Save data as CSV with "~" delimiter
Dim Rng As Range, DF1 As Byte, File$, Tp1, Rz$, Ki&, Kj%, i&, j%
Set Rng = ActiveSheet.Cells(1).CurrentRegion
    File = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\" & Rng.Parent.Name & ".csv"
Tp1 = Rng.Value: Rz = "~": Ki = Rng.Rows.Count: Kj = Rng.Columns.Count
    DF1 = FreeFile: Open File For Output As #DF1
For i = 1 To Ki
    For j = 2 To Kj
        Tp1(i, 1) = ChangeTextCharset(Tp1(i, 1), "utf-8","Windows-1251") & Rz & Tp1(i, j)
    Next j
    If i = Ki Then Print #DF1, ChangeTextCharset(Tp1(i, 1), "utf-8","Windows-1251"); Else Print #DF1, ChangeTextCharset(Tp1(i, 1), "utf-8","Windows-1251")
Next i: Close
End Sub

'-----------------------------------------
Function ChangeTextCharset(ByVal txt$, ByVal DestCharset$, Optional ByVal SourceCharset$) As String If Trim(txt$) = "" Then
  ChangeTextCharset = ""
 Else
  On Error Resume Next: Err.Clear
    'SourceCharset$ = "Windows-1251"
    'DestCharset$ = "utf-8"
  With CreateObject("ADODB.Stream")
   .Type = 2
   .Mode = 3
   If Len(SourceCharset$) Then .Charset = SourceCharset$    'Ischodnaja kodirovka
   .Open
   .WriteText txt$
   .Position = 0
   .Charset = DestCharset$                                  'Naznachenie novoji kodirovki
   ChangeTextCharset = .ReadText
   .Close
  End With
 End If
End Function

//GetValue
(rangeName) => 
    Excel.CurrentWorkbook(){[Name=rangeName]}[Content]{0}[Column1]

let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    #"Added Custom" = Table.AddColumn(Source, "Custom", each if [Продукт] = GetValue("var_1") and 
                                                                [Цена] = GetValue("var_2") and 
                                                                [Цвет] = GetValue("var_3") then 
                                                                [Вледелец] else "n/a"),
    #"Filtered Rows" = Table.SelectRows(#"Added Custom", each ([Custom] <> "n/a")),
    #"Removed Other Columns" = Table.SelectColumns(#"Filtered Rows",{"Custom"}),
    #"Removed Duplicates" = Table.Distinct(#"Removed Other Columns"),
    #"Renamed Columns" = Table.RenameColumns(#"Removed Duplicates",{{"Custom", "Вледелец"}})
in
    #"Renamed Columns"

Function ChangeTextCharset(ByVal txt$, ByVal DestCharset$, Optional ByVal SourceCharset$) As String
 If Trim(txt$) = "" Then
  ChangeTextCharset = ""
 Else
  On Error Resume Next: Err.Clear
    'SourceCharset$ = "Windows-1251"
    'DestCharset$ = "utf-8"
  With CreateObject("ADODB.Stream")
   .Type = 2
   .Mode = 3
   If Len(SourceCharset$) Then .Charset = SourceCharset$    'Ischodnaja kodirovka
   .Open
   .WriteText txt$
   .Position = 0
   .Charset = DestCharset$                                  'Naznachenie novoji kodirovki
   ChangeTextCharset = .ReadText
   .Close
  End With
 End If
End Function

Sub SaveSheetToCSV()
    ActiveWorkbook.SaveAs Filename:="C:\Users\xyz\Desktop\combine.csv", FileFormat:=xlCSVUTF8, Local:=True, CreateBackup:=False
    ActiveWorkbook.Close SaveChanges:=False
End Sub

'CodeLocation >> ThisWorkbook

Private Sub Workbook_Save()
    Dim ThisBook As Workbook
    Dim ws As Worksheet
    Dim copyName As String
    
    Set ThisBook = ThisWorkbook
    Set ws = ThisBook.Worksheets("cover")
    
    'file path connected to named range.
    'filepath5 = "https://xxx.sharepoint.com/personal/user_xxx/Documents/CA%20CZ%20Handover/Macro%20preparation/CA%20Tool/Archiving/CA_DB%20Backup%20210521133611.xlsm"
    
    copyName = ws.Range("filepath5") 
        
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
            If ThisBook.Name <> "CA_DB.xlsm" Then
                Exit Sub
                Else       
                ThisWorkbook.SaveCopyAs copyName
                ActiveWorkbook.Save
            End If
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With
    MsgBox "Backup for [CA_DB yyyy-mm-dd hhmmss.xlsm] has been created."
End Sub

Sub recap_data1()
Dim wbk As Workbook
Dim wsh As Worksheet
Dim trgtrng As Range
Dim ConsolidateRangeArray As Variant

Set wbk = Workbooks(Range("BookName").Value)
Set wsh = wbk.Worksheets("Recap")
Set trgtrng = wsh.Range("D12")

  ConsolidateRangeArray = Array("5220!R12C4:R14C8", "400E!R12C4:R14C8", _
                                "4124!R12C4:R14C8", "552E!R12C4:R14C8", _
                                "5304!R12C4:R14C8", "539D!R12C4:R14C8", _
                                "5706!R12C4:R14C8", "5356!R12C4:R14C8", _
                                "4349!R12C4:R14C8", "546E!R12C4:R14C8", _
                                "4187!R12C4:R14C8", "5255!R12C4:R14C8", _
                                "5286!R12C4:R14C8", "5244!R12C4:R14C8", _
                                "5975!R12C4:R14C8", "546P!R12C4:R14C8", _
                                "443x!R12C4:R14C8", "4104!R12C4:R14C8", _
                                "5300!R12C4:R14C8", "527P!R12C4:R14C8", _
                                "504N!R12C4:R14C8", "503N!R12C4:R14C8", _
                                "502B!R12C4:R14C8", "5985!R12C4:R14C8", _
                                "5355!R12C4:R14C8", "442N!R12C4:R14C8", _
                                "4721!R12C4:R14C8")

    trgtrng.Consolidate Sources:=ConsolidateRangeArray, Function:=xlSum
End Sub

let
    Source_1 = group_1,
    
   Filtered_Rows = Table.SelectRows(
         Source_1, each ([Index] = 1)),
   Filtered_Rows1 = Table.SelectRows(
         Filtered_Rows, each not Text.Contains([Value], "Date")),

    Source_2 = Filtered_Rows1,
    logic_test = Table.IsEmpty(Source_2), // logic fx, If True then -> Alternative tbl if False then -> Columns

            Grouped = Table.Group(
                Source_2, 
                {"Value"}, 
                {{"columns", each List.Skip([Value]), type table}}, 
                0, 
                (a,b)=>Number.From( Text.Range(b[Value], 3, 1) <> "." ) ),
            Сolumns = Table.FromColumns( Grouped[columns], Grouped[Value] ),
            
    alternative_tbl = Excel.CurrentWorkbook(){[Name="tbl_if_nodata"]}[Content],       
    
   result = try сolumns otherwise alternative_tbl
in
    result

let

    FilePath = Excel.CurrentWorkbook(){[Name="Path_CPD2"]}[Content]{0}[Column1],

   

    fileContentsOrError = Excel.Workbook(File.Contents(FilePath), null, true),

    tbl_data = fileContentsOrError{[Item="Sheet1",Kind="Sheet"]}[Data],

   

    alternative_tbl = Excel.CurrentWorkbook(){[Name="tbl_Error_Handler"]}[Content],

    result = try tbl_data otherwise alternative_tbl,

   

    #"Promoted Headers" = Table.PromoteHeaders(result, [PromoteAllScalars=true])

in

    #"Promoted Headers"

=INDEX('Project Expenses'!N:CS,MATCH(1,(report!B2='Project Expenses'!E:E)*(report!C2='Project Expenses'!K:K),0),$F$1)

Sub automatic_data_population()
    Dim i As Integer
    Dim lastrow As Integer
    
    With Sheets("sheet1")
    'fetch the row no of lastrow based on the data in column D(4)
    lastrow = .Cells(Rows.Count, 4).End(xlUp).Row
    
    'add row ="S", even row = "H"
    For i = 11 To lastrow
        If i Mod 2 Then
        .Cells(i, 3) = "S"
        Else
        .Cells(i, 3) = "H"
        End If
    Next
    End With
End Sub

Sub copy_filtered_data_1()
    Dim wsCopy As Worksheet
    Dim wsDest As Worksheet
    Dim lo As ListObject
    Dim iCol_1 As Long
    Dim iCol_2 As Long
    Dim iCol_3 As Long
    Dim wsMapping As Worksheet

        Set wsCopy = Worksheets(Range("Sheet_name_support").Value)
        Set wsDest = Worksheets("dev_v1")
        Set lo = ActiveSheet.ListObjects(1)
        
        Worksheets(Range("Sheet_name_support").Value).Activate

            iCol_1 = lo.ListColumns(Range("dev_1_column1").Value).Index
            iCol_2 = lo.ListColumns(Range("dev_1_column2").Value).Index
            iCol_3 = lo.ListColumns(Range("dev_1_column3").Value).Index

        wsCopy.ListObjects(1).ListColumns(iCol_1).DataBodyRange.Copy wsDest.Range("I11")
        wsCopy.ListObjects(1).ListColumns(iCol_2).DataBodyRange.Copy wsDest.Range("K11")
        wsCopy.ListObjects(1).ListColumns(iCol_3).DataBodyRange.Copy wsDest.Range("D11")
End Sub