MACRO Help, tricky...if not impossible

[nhbartos]

Good morning,

Novice here, self teaching and not up on all the lingo.

I have attached a link to a file that shows what I am looking to do, however briefly...

I created a client data summary page that links data from 100 +/- client tabs.
I have a macro at the top that inserts a new summary section into the summary page, at ROW 13, and pulls in data/links from a newly created customer tab.

In order to maximize space, I condensed and merged cells. I know, I know...
The summary is 20 pages long and it needed to be printable on landscape, and I just could not put all the data end to end.

HOWEVER, the summary is fine as it is, but now I have to pull only certain cells, 10 in total, from the roughly 80, from each client summary and link to a second summary page.

I am not sure how to do this because:

Clients will come and go.
Summary sections will be added and deleted.
Client summaries and cell positions will change.

Is there any way to do this by creating a macro to search for specific cell, cell ranges, and pull it to a second summary tab, by searching within a page break preview?


https://www.dropbox.com/s/fp4kb9r3lpgbfz6/Book1.xlsx?dl=0

I appreciate the feedback.

 

[RickXL]

Hi,

I used your workbook but added another worksheet called "Data Summary Test" so that I did not overwrite yours. To run the code you will either need to change that name or add a new sheet with that name.
I assumed that the extra writing after the data in the Original Data Summary sheet will not be there. I need to find the last used row (in column R).
I also assumed that the first data row would be 14 so I looped from there in steps of 6 rows until the end.
Each block of rows was "straightened out" and written to the summary sheet.
I then added code to format the output sheet.

Then I thought about the statistics. There is an array which is followed by the comment:"Add more statistics here". You can add new functions in there and it should add a new row and perform the desired calculation.

The code needs to be pasted into a new macro Module (VB Editor-->Insert-->Module.)

Option Explicit
Sub Summarize()
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim i As Long
    Dim iOut As Long
    Dim arrStats As Variant
    
    Application.ScreenUpdating = False
    
    '=================================================================
    ' Choose the Sheets to use
    '=================================================================
    Set ws1 = ThisWorkbook.Worksheets("Original Data Summary")
    Set ws2 = ThisWorkbook.Worksheets("Data Summary Test")
    
    '=================================================================
    ' Clear the output sheet and write the headings
    '=================================================================
    With ws2
        .Cells.Clear
        .Range("A1:K1").Value = Array("", "", "Count", "%", "", "Count", "%", "", "Count", "%", "")
    End With
    
    '=================================================================
    ' Read the input data and write it in the correct format
    '=================================================================
    With ws1
        iOut = 2
        For i = 14 To .Cells(.Rows.Count, "R").End(xlUp).Row Step 6
            ws2.Cells(iOut, "A") = .Cells(i, "A").Value
            ws2.Cells(iOut, "B") = .Cells(i, "R").Value
            ws2.Cells(iOut, "C") = .Cells(i, "R").Offset(1).Value
            ws2.Cells(iOut, "D") = .Cells(i, "R").Offset(2).Value
            ws2.Cells(iOut, "E") = .Cells(i, "S").Value
            ws2.Cells(iOut, "F") = .Cells(i, "S").Offset(1).Value
            ws2.Cells(iOut, "G") = .Cells(i, "S").Offset(2).Value
            ws2.Cells(iOut, "H") = .Cells(i, "T").Value
            ws2.Cells(iOut, "I") = .Cells(i, "T").Offset(1).Value
            ws2.Cells(iOut, "J") = .Cells(i, "T").Offset(2).Value
            iOut = iOut + 1
        Next
    End With
              
    '=================================================================
    ' Format the output sheet
    '=================================================================
    With ws2
        .Rows("1:1").Font.Bold = True
        With .Columns("A:A")
            .VerticalAlignment = xlCenter
            .Font.Color = RGB(83, 141, 243)
            .Font.Bold = True
            .EntireColumn.AutoFit
        End With
        .Columns("B:B").WrapText = True
        .Columns("B:B").ColumnWidth = 9
        .Columns("D:D").NumberFormat = "0%"
        .Columns("G:G").NumberFormat = "0%"
        .Columns("H:H").WrapText = True
        .Columns("B:J").HorizontalAlignment = xlCenter
        With .Range("A1:J" & iOut - 1).Borders
            .LineStyle = xlContinuous
            .Weight = xlThin
        End With
        
    '=================================================================
    ' Add the statistics at the end of the sheet
    '=================================================================
        arrStats = Array("Average", "Min", "Max", "StDev") ' <== Add more statistics here
        For i = 0 To UBound(arrStats)
            .Cells(i + 1 + iOut, "B") = arrStats(i)
            .Cells(i + 1 + iOut, "C") = "=" & arrStats(i) & "(C2:C" & iOut & ")"
            .Cells(i + 1 + iOut, "D") = "=" & arrStats(i) & "(D2:D" & iOut & ")"
            .Cells(i + 1 + iOut, "E") = arrStats(i)
            .Cells(i + 1 + iOut, "F") = "=" & arrStats(i) & "(F2:F" & iOut & ")"
            .Cells(i + 1 + iOut, "G") = "=" & arrStats(i) & "(G2:G" & iOut & ")"
            .Cells(i + 1 + iOut, "H") = arrStats(i)
            .Cells(i + 1 + iOut, "I") = "=" & arrStats(i) & "(I2:I" & iOut & ")"
            .Cells(i + 1 + iOut, "J") = "=" & arrStats(i) & "(J2:J" & iOut & ")"
        Next
  
    '=================================================================
    ' Add the box round the statistics
    '=================================================================
        With .Range("B" & iOut + 1 & ":J" & iOut + i).Borders
            .LineStyle = xlContinuous
            .Weight = xlThin
        End With
    End With
    
    Application.ScreenUpdating = True
    
End Sub

 

[nhbartos]

Hi Rick, thanks!!!!!!!!

 

[RickXL]

Hi,

No problem.

It turned out longer than I expected because of making the statistics section the way I did.

Still, it is all practice

Regards,