Manipulation of data across many workbooks

[tomas]

Hi,

I have a public sourced data in many excel files stored in one dircetory. Each file contain data for one let's say county. And there is data structure that for each year you have new table with demographic estimation. Format of file as you see is not usable for analyses and furthermove there is merged cell with data I need to put to many cell.

What I want: data on the left to be rearranged as on the right in yellow cells.

Next step would be to copy this rearranged datasets from all workbooks in directory into one dataset.

thanks for any effort

 

[Nebu]

Hi:

Find the attached. If this is what you are looking for , the code for looping between work book can be added.

Thanks

 

[tomas]

Hi Great Job !

Only thing is I wanted to preserve name of columns in first row but this I can do myself.

About looping over workbooks, Structure is the same but after unmerging in cell A1 the name of "okres" it's variable not a constant

Thanks !

 

[Nebu]

Hi:

My code will preserve the headings.It just that I clicked the clear button 2 times by mistake then the headers got deleted. Your periods are there is the cell A1 , It can be referenced from there to make it dynamic, I just hard coded it for simplicity purpose.I also assumed that your start year will be 2013 and you will have same categories across the work books.Let me know your thoughts.

Thanks

 

[tomas]

Hi yes all categories will be the same , only changing variables are okres and values inside

 

[Nebu]

Hi:

Use this code to loop through files. I have not tested it extensively . The code will basically manipulate the data in Sheet 3 (vek5) and copies the data to the final tab.

Sub DataCln()
Application.ScreenUpdating = False

Dim i As Long
Dim yrs As Long
Dim c As Long
Dim Fcount As Long
Dim Rfound As Range
Dim Ctr As Long
Dim Arr
Dim wbk As Workbook
Dim Fname As String
Dim Fpath As String

Sheet3.Range("A1:I" & Sheet3.Cells(Rows.Count, "A").End(xlUp).Row).ClearContents
Fpath = ThisWorkbook.Path & "\New folder\"
Fcount = Workbooks.Count
Fname = Dir(Fpath & "*.xls")
Ctr = 1

Do While Len(Fname) > 0 And Ctr = Fcount
    Set wbk = Workbooks.Open(Fpath & Fname)
    With wbk.Sheets("vek5")
        .Range("A1:G" & .Cells(Rows.Count, "A").End(xlUp).Row).Copy
    End With
    Sheet3.Range("A" & Sheet3.Cells(Rows.Count, "A").End(xlUp).Row).PasteSpecial
    Application.CutCopyMode = False
    wbk.Close
    yrs = 2013
    Arr = Array(2013, "Spolu", "", 2014, "Spolu", "VEK", "", 2015, "Spolu", "VEK", "", 2016, "Spolu", "VEK", "", 2017, "Spolu", "VEK", "", 2018, "Spolu", "VEK", "", 2019, "Spolu", "VEK", "", 2020, "Spolu", "VEK", "", 2021, "Spolu", "VEK", "", 2022, "Spolu", "VEK", "", 2023, "Spolu", "VEK", "", 2024, "Spolu", "VEK", "", 2025, "Spolu", "VEK", "", 2026, "Spolu", "VEK", "", 2027, "Spolu", "VEK", "", 2028, "Spolu", "VEK", "", 2029, "Spolu", "VEK", "", 2030, "Spolu", "VEK", "", 2031, "Spolu", "VEK", "", 2032, "Spolu", "VEK", "", 2033, "Spolu", "VEK", "", 2034, "Spolu", "VEK", "", 2035, "Spolu", "VEK", "")
    i = Sheet3.Cells(Rows.Count, "A").End(xlUp).Row

    For c = LBound(Arr) To UBound(Arr)
        With Sheet3
            .Cells.UnMerge
            Set Rfound = .Range("A2:A" & i).Find(what:=Arr(c))
            If Not Rfound Is Nothing Then
                Rfound.EntireRow.Delete
            End If
        End With
    Next

    Sheet3.[H2] = "rok"
    Sheet3.[I2] = "okres"
    Sheet3.Range("I3:I" & Sheet3.Cells(Rows.Count, "A").End(xlUp).Row) = Sheet3.[A1]
    Sheet3.Range("A1").ClearContents

    For m = 3 To Sheet3.Cells(Rows.Count, "A").End(xlUp).Row Step 21
        Sheet3.Range("H" & m & ":H" & m + 20) = yrs
        yrs = yrs + 1
    Next
 
    Sheet3.Range("A3:I" & Sheet3.Cells(Rows.Count, "A").End(xlUp).Row).Copy
    Sheet4.Range("A" & Sheet4.Cells(Rows.Count, "A").End(xlUp).Row + 1).PasteSpecial
    Application.CutCopyMode = False
    Ctr = Ctr + 1
Loop

Application.ScreenUpdating = False

End Sub

Let me know with questions if any

 

[tomas]

Hi Nebu

thank you for the work you have done.

I ran into trouble

Fname = Dir(Fpath & "*.xls")
Ctr = 1

Do While Len(Fname) > 0 And Ctr = Fcount

Variable Fname is after executing empty string so while loop doesn't start.Fpath hovewer is string showing new folder in locals window.

I put macro in one of the worbooks, supposedly I have should done so.[/CODE]

 

[Nebu]

Hi:

I am not sure what is happening at your end. I guess it is something to do with your file path. Note, I have created a folder called New folder if you do not have a folder named New folder in your file path you may have to modify the path accordingly. ThisWorkbook.Path will give you the file path where your macro file is saved.

Thanks