							Contact Us! California (408) 835-8436 Rhode Island (401) 580-5289 Questions? Comments?
Home	Case Studies	MS Office Tips and Tricks	Sample Code	Helpful Videos	Custom Development	Custom Training	Join Us	About Us
Search Our Site:

The Un-PivotTable Code

Sub UnPivotTable()

        

        
        MasterFilePath = ActiveWorkbook.Path

        

            
            
        'This line automatically assumes you're 
        doing the work on Monday morning

        'so it looks for a folder with Today's date for a name

            
        ThisWeeksFilesPath = ActiveWorkbook.Path & "\" & Format(Date, "yyyymmdd")

        

            
        'If you want to clear out all the old 
        files by hand and use

        'the same folder name all of the time, use the line below by

        'removing the ' at the start of the line

            
        'ThisWeeksFilesPath = ActiveWorkbook.Path & "\FieldReportFiles"

        

        Set MasterWorkbook = Workbooks.Add

        MasterWorkbook.Sheets(1).Cells(1, 1) = "Service"

        MasterWorkbook.Sheets(1).Cells(1, 2) = "Package"

        MasterWorkbook.Sheets(1).Cells(1, 3) = "Hours"

        MasterWorkbook.Sheets(1).Cells(1, 4) = "Field Rep"

        

        MasterWorkbook.SaveAs Filename:=MasterFilePath & "\Consolidated Reports 
        From " & Format(Date, "yyyymmdd"), AddToMRU:=True

        

        Application.FileSearch.NewSearch

        Application.FileSearch.FileType = msoFileTypeExcelWorkbooks

        Application.FileSearch.LookIn = ThisWeeksFilesPath

        Application.FileSearch.Execute

        

        For Each ReportFile In Application.FileSearch.FoundFiles

        

        Set SourceWorkbook = Workbooks.Open(ReportFile, ReadOnly:=True)

        

            
        'Find the . in XXX.xls and read 
        everything to the left of it - that's the rep's name

            
        RepName = Left(SourceWorkbook.Name, InStr(1, SourceWorkbook.Name, ".") - 
        1)

        

        For RowNumber = 3 To 13

        ServiceName = SourceWorkbook.Sheets(1).Cells(RowNumber, 1)

        

        For ColNumber = 2 To 6

        PackageName = SourceWorkbook.Sheets(1).Cells(2, ColNumber)

        

        HoursOfService = SourceWorkbook.Sheets(1).Cells(RowNumber, 
        ColNumber).Value

        

        If HoursOfService > 0 Then

        

        FirstBlankRow = MasterWorkbook.Sheets(1).UsedRange.Rows.Count + 1

        

        MasterWorkbook.Sheets(1).Cells(FirstBlankRow, 1) = ServiceName

        MasterWorkbook.Sheets(1).Cells(FirstBlankRow, 2) = PackageName

        MasterWorkbook.Sheets(1).Cells(FirstBlankRow, 3) = HoursOfService

        MasterWorkbook.Sheets(1).Cells(FirstBlankRow, 4) = RepName

        

        End If

        

        Next ColNumber

        Next RowNumber

        

        SourceWorkbook.Close SaveChanges:=False

        Next ReportFile

        

        MasterWorkbook.Save

        

        End Sub

References

Journal of Accountancy Articles

Tweaking The Numbers

Block That Spreadsheet Error

Excel Security Issues

Clients

Do you need help with Microsoft Office? Contact us

See how we've helped companies like yours develop effective business processes

Client Success Stories

Consultants

I Get It! Consultants set their own hours, work with their own clients, and choose their own projects.

If you're a Microsoft Office guru and would like to explore being a full-time consultant, please see our consultant information pages.