Sub Macro1()
'
' Macro1
'
' upravuje nakopirovane zaznamy z FamilySearch (cez #zaznamyFS.iim) vo formate html


'
    'Sheets("Hárok1").Select
    'Sheets("Hárok2").Select
    'ActiveWindow.SelectedSheets.Delete
    Sheets("Hárok1").Select
    Sheets("Hárok1").Copy After:=Sheets(1)
    Sheets("Hárok1 (2)").Select
    Sheets("Hárok1 (2)").Name = "Hárok2"
    Range("A1").Select

    ' zrus spojene bunky a zalamovanie textu podla bunky
    Cells.Select
    Selection.UnMerge
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = -1
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With

    
    ' vlož stĺpce pre dátum a miesto
    Columns("D:E").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    ' vlož stĺpce pre meno otca, matku a jej meno
    Columns("G:I").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    ' pomenuj slĺpce
    Range("D2").Select
    ActiveCell.FormulaR1C1 = "datum"
    Range("E2").Select
    ActiveCell.FormulaR1C1 = "miesto"
    Range("F2").Select
    ActiveCell.FormulaR1C1 = "otec"
    Range("G2").Select
    ActiveCell.FormulaR1C1 = "meno_otca"
    Range("H2").Select
    ActiveCell.FormulaR1C1 = "matka"
    Range("I2").Select
    ActiveCell.FormulaR1C1 = "meno_matky"

    'presun "matku" do rovnakeho riadku ako je osoba resp. "otec"
    Dim myRange, uprRange As Range
    
    Range("A1").Select
    ActiveCell.SpecialCells(xlLastCell).Select
    riadkov = ActiveCell.Row
    stlpcov = ActiveCell.Column
    Set myRange = ActiveSheet.Range(Cells(1, 1), Cells(riadkov, stlpcov))
    

    Range("C3:C" & CStr(riadkov)).Select            'udalosť !!
    Set xRng = Selection
    x = "baptism:"
    
        For Each xR In xRng
            If Trim(CStr(xR.Value)) = x Then
                Range("C" & CStr(xR.Row + 1)).Cut Destination:=Range("D" & CStr(xR.Row))             'dátum
                Range("C" & CStr(xR.Row + 2)).Cut Destination:=Range("E" & CStr(xR.Row))             'miesto
            End If
        Next xR
        
    Range("F3:F" & CStr(riadkov)).Select            'rodičia !!
    Set xRng = Selection
    x = "father:"
    y = "mother:"
    posun = 2
    
        For Each xR In xRng
            If Trim(CStr(xR.Value)) = x Then                                                         'father
                Range("F" & CStr(xR.Row + 1)).Cut Destination:=Range("G" & CStr(xR.Row))             'meno_otca
                posun = 2
            End If
            If Trim(CStr(xR.Value)) = y Then                                                         'mother
                Range("F" & CStr(xR.Row + 1)).Cut Destination:=Range("I" & CStr(xR.Row - posun))     'meno_matky
                Range("F" & CStr(xR.Row + 0)).Cut Destination:=Range("H" & CStr(xR.Row - posun))     'mother
                posun = 0
            End If
        Next xR
        
    ' vymaž zbytočné stĺpce
    Range("A1").Select
    Range("A:A,F:F,H:H,J:J,K:K").Select
    Selection.Delete Shift:=xlToLeft
    Rows("1:1").Select
    Selection.Delete Shift:=xlUp
    Cells.EntireColumn.AutoFit
    Selection.RowHeight = 15
    

    'zatried data a odstran zbytocne veci
    Range("A1").Select
    ActiveCell.SpecialCells(xlLastCell).Select
    riadkov = ActiveCell.Row
    stlpcov = ActiveCell.Column
    Set myRange = ActiveSheet.Range(Cells(1, 1), Cells(riadkov, stlpcov))

    myRange.Select
    ActiveWorkbook.ActiveSheet.Sort.SortFields.Clear
    ActiveWorkbook.ActiveSheet.Sort.SortFields.Add Key:=ActiveCell. _
        Offset(0, 3).Range(Cells(1, 1), Cells(riadkov, 1)), SortOn:=xlSortOnValues, Order:=xlAscending, _
        DataOption:=xlSortNormal
    With ActiveWorkbook.ActiveSheet.Sort
        .SetRange ActiveCell.Range(Cells(1, 1), Cells(riadkov, stlpcov))
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

    ActiveCell.SpecialCells(xlLastCell).Select
    r2 = ActiveCell.Row
    s2 = ActiveCell.Column
    Range("C1").Select
    Selection.End(xlDown).Select
    r1 = ActiveCell.Row
    rr = r1 & ":" & r2 + 1
    Rows(rr).Select
    Selection.Delete
    Range("A1").Select

    'dopln chybajuce stlpce a hlavicku
    Columns("B:E").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Font.Underline = xlUnderlineStyleNone
    With Selection.Font
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
    End With
    Columns("H:L").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Columns("O:R").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Rows("1:1").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Rows("1:1").Select
    Selection.Font.Bold = True
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "osoba"
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "m1"
    Range("C1").Select
    ActiveCell.FormulaR1C1 = "m2"
    Range("D1").Select
    ActiveCell.FormulaR1C1 = "meno"
    Range("E1").Select
    ActiveCell.FormulaR1C1 = "priezvisko"
    Range("F1").Select
    ActiveCell.FormulaR1C1 = "udalosť"
    Range("G1").Select
    ActiveCell.FormulaR1C1 = "dátum"
    Range("H1").Select
    ActiveCell.FormulaR1C1 = "m3"
    Range("I1").Select
    ActiveCell.FormulaR1C1 = "m4"
    Range("J1").Select
    ActiveCell.FormulaR1C1 = "d"
    Range("K1").Select
    ActiveCell.FormulaR1C1 = "m"
    Range("L1").Select
    ActiveCell.FormulaR1C1 = "r"
    Range("M1").Select
    ActiveCell.FormulaR1C1 = "miesto"
    Range("N1").Select
    ActiveCell.FormulaR1C1 = "otec"
    Range("O1").Select
    ActiveCell.FormulaR1C1 = "m5"
    Range("P1").Select
    ActiveCell.FormulaR1C1 = "m6"
    Range("Q1").Select
    ActiveCell.FormulaR1C1 = "meno_o"
    Range("R1").Select
    ActiveCell.FormulaR1C1 = "priezvisko_o"
    Range("S1").Select
    ActiveCell.FormulaR1C1 = "matka"
    Range("T1").Select
    ActiveCell.FormulaR1C1 = "m7"
    Range("U1").Select
    ActiveCell.FormulaR1C1 = "m8"
    Range("V1").Select
    ActiveCell.FormulaR1C1 = "meno_m"
    Range("W1").Select
    ActiveCell.FormulaR1C1 = "priezvisko_m"
    Range("A1").Select
    Cells.EntireColumn.AutoFit

    ' dopln vzorce
    Range("B2").Select      ' osoba
    ActiveCell.FormulaR1C1 = "=IF(ISNUMBER(FIND("" "", TRIM(RC[-1]))), FIND("" "", TRIM(RC[-1])), 0)"
    Range("C2").Select
    ActiveCell.FormulaR1C1 = "=IF(RC[-1]>0, IF(ISNUMBER(FIND("" "", TRIM(RC[-2]), RC[-1]+1)), FIND("" "", TRIM(RC[-2]), RC[-1]+1), RC[-1]), 0)"
    Range("D2").Select
    ActiveCell.FormulaR1C1 = "=IF(RC[-1]=0, """", TRIM(LEFT(RC[-3], RC[-1]-1)))"
    Range("E2").Select
    ActiveCell.FormulaR1C1 = "=IF(RC[-2]=0, TRIM(RC[-4]), RIGHT(TRIM(RC[-4]), LEN(TRIM(RC[-4]))-RC[-2]))"
    
    Range("H2").Select      ' dátum
    ActiveCell.FormulaR1C1 = "=IF(ISNUMBER(FIND("" "", RC[-1])), FIND("" "", RC[-1]), 0)"
    Range("I2").Select
    ActiveCell.FormulaR1C1 = "=IF(RC[-1]>0, IF(ISNUMBER(FIND("" "", RC[-2], RC[-1]+1)), FIND("" "", RC[-2], RC[-1]+1), RC[-1]), 0)"
    Range("J2").Select
    ActiveCell.FormulaR1C1 = "=IF(RC[-2]=RC[-1], """", LEFT(RC[-3], RC[-2]-1))"
    Range("K2").Select
    ActiveCell.FormulaR1C1 = "=IF(RC[-3]<RC[-2], MID(RC[-4], RC[-3]+1, RC[-2]-RC[-3]), IF(RC[-2]=0, """", LEFT(RC[-4], RC[-2]-1)))"
    Range("L2").Select
    ActiveCell.FormulaR1C1 = "=IF(RC[-3]=0, RC[-5], RIGHT(RC[-5], LEN(RC[-5])-RC[-3]+1))"
             
    Range("B2:E2").Select   ' otec a matka je to isté ako osoba
    Selection.Copy
    Range("O2").Select
    ActiveSheet.Paste
    Range("T2").Select
    ActiveSheet.Paste
    
    'nakopíruj vzorce na celý rozsah
    Range("B2:E2").Select
    Application.CutCopyMode = False
        
    rr = "B2:E" & r1
    Selection.AutoFill Destination:=Range(rr), Type:=xlFillDefault
    rr = "H2:L" & r1
    Range("H2:L2").Select
    Selection.AutoFill Destination:=Range(rr), Type:=xlFillDefault
    Range("O2:R2").Select
    rr = "O2:R" & r1
    Selection.AutoFill Destination:=Range(rr), Type:=xlFillDefault
    Range("T2:W2").Select
    rr = "T2:W" & r1
    Selection.AutoFill Destination:=Range(rr), Type:=xlFillDefault
    Cells.Select
    Cells.EntireColumn.AutoFit
    Range("A1").Select

    ' mena mesiacov nahrad poradovym cislom
    Columns("L:L").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Columns("K:K").Select
    Selection.Copy
    Columns("L:L").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Selection.Replace What:="Január", Replacement:="1", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="Február", Replacement:="2", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="Marec", Replacement:="3", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="Apríl", Replacement:="4", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="Máj", Replacement:="5", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="Jún", Replacement:="6", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="Júl", Replacement:="7", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="August", Replacement:="8", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="September", Replacement:="9", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="Október", Replacement:="10", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="November", Replacement:="11", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="December", Replacement:="12", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    
    Range("K1").Select
    ActiveCell.FormulaR1C1 = "mes"
    

    'zotried podla roku, mesiaca, dna
    Cells.Select
    ActiveWorkbook.ActiveSheet.Sort.SortFields.Clear
    rr = "M2:M" & r2 + 1
    ActiveWorkbook.ActiveSheet.Sort.SortFields.Add Key:=Range(rr _
        ), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortTextAsNumbers
    rr = "L2:L" & r2 + 1
    ActiveWorkbook.ActiveSheet.Sort.SortFields.Add Key:=Range(rr _
        ), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortTextAsNumbers
    rr = "J2:J" & r2 + 1
    ActiveWorkbook.ActiveSheet.Sort.SortFields.Add Key:=Range(rr _
        ), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortTextAsNumbers
    
    rr = "A1:W" & r2 + 1
    With ActiveWorkbook.ActiveSheet.Sort
        .SetRange Range(rr)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    
    

    '////////////////////////////
    'vytvor kontingencnu tabulku
    
    'refer Image DataSource for source data. Note that the complete data table extends upto row number 49.
    'refer Image 1 for PivotTable report created after running below code
    
    Dim PvtTbl As PivotTable
    Dim wsData As Worksheet
    Dim DataRng As Range
    Dim PvtTblCache As PivotCache
    Dim wsPvtTbl As Worksheet
    Dim pvtFld As PivotField
    
    'determine the worksheet which contains the source data
    Set wsData = ActiveSheet
    meno = ActiveSheet.Name
    
    'set source data range:
    Cells.Select
    Range("A1").Activate
    Selection.End(xlDown).Select
    Selection.End(xlToRight).Select
    riadkov = ActiveCell.Row
    stlpcov = ActiveCell.Column
    Set DataRng = ActiveSheet.Range(Cells(1, 1), Cells(riadkov, stlpcov))
           
    'determine the worksheet where the new PivotTable will be created
    newmeno = meno & "PivotTable"
    Sheets.Add
    ActiveSheet.Name = newmeno
    Set wsPvtTbl = Worksheets(newmeno)
    
    'delete all existing Pivot Tables in the worksheet
    'in the TableRange1 property, page fields are excluded; to select the entire PivotTable report, including the page fields, use the TableRange2 property.
    For Each PvtTbl In wsPvtTbl.PivotTables
        If MsgBox("Delete existing PivotTable!", vbYesNo) = vbYes Then
            PvtTbl.TableRange2.Clear
        End If
    Next PvtTbl
     
    
    'A Pivot Cache represents the memory cache for a PivotTable report. Each Pivot Table report has one cache only. Create a new PivotTable cache, and then create a new PivotTable report based on the cache.
    wsPvtTbl.Select
    
    
    'for creating a Pivot Cache (version excel 2007), use the PivotCaches.Create Method. When version is not specified, default version of the PivotTable will be xlPivotTableVersion12.
    
    'The PivotCache.CreatePivotTable method creates a PivotTable report based on a Pivot Cache. TableDestination is mandatory to specify in the method.
    
    'create Pivot Cache and PivotTable version excel 2007:
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=DataRng, Version:=xlPivotTableVersion12).CreatePivotTable TableDestination:=wsPvtTbl.Range("A1"), TableName:="PivotTable1", DefaultVersion:=xlPivotTableVersion12
    
    Set PvtTbl = wsPvtTbl.PivotTables("PivotTable1")
     
    'Default value of ManualUpdate property is False wherein a PivotTable report is recalculated automatically on each change. Turn off automatic updation of Pivot Table during the process of its creation to speed up code.
    PvtTbl.ManualUpdate = True
    
    
    'add row, column and page (report filter) fields:
    Set pvtFld = PvtTbl.PivotFields("priezvisko")
    pvtFld.Orientation = xlRowField
    
    'Set pvtFld = PvtTbl.PivotFields("Car Models")
    Set pvtFld = PvtTbl.PivotFields("miesto")
    pvtFld.Orientation = xlColumnField
    
    
    'set data field - specifically change orientation to a data field and set its function property:
    With PvtTbl.PivotFields("priezvisko")
        .Orientation = xlDataField
        .Function = xlCount
        .NumberFormat = "# ##0"
        .Position = 1
    End With
    
    
    'turn on automatic update / calculation in the Pivot Table
    PvtTbl.ManualUpdate = False
    
    'Application.Version Property - returns the Excel version number in which VBA is being executed viz. 9.0, 10.0, 11.0, 12.0, etc.
    'MsgBox Application.Version
    
    'PivotTable.Version Property - returns the PivotTable version number, 0, 1, 2, 3, etc.
    'MsgBox PvtTbl.Version
    


End Sub