asked on

Excel Macro

Hi Experts,
this is a question to the following answer.
https://www.experts-exchange.com/questions/26972706/Excel-Macro.html?anchorAnswerId=35461141#a35461141

I am trying to modify the macro to include an extra requirement , I would like to have the total numbers of line for each sheet in my spreadsheet , it can says: Total Job: ####
then on the Summary page I would like to have a column with the total jobs for each sheet as well.
I just want to be clear I only need the number of jobs not including the headers

Thanks
David

ASKER CERTIFIED SOLUTION

byundt

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

taverny

ASKER

Hy Byundt,
sorry , attached is the row data before the macro.
I will test your code right now .
thanks for the prompt response.
David
RawData.xls

byundt

David,
I found sample data here: http:/Q_26971985.html and the posted code seems to be working.

Brad

taverny

ASKER

Thanks Brad it does work.
Thank you for your help.
David

taverny

ASKER

Hi Brad,

I am sorry to ask you that now and If it is out of the scope of this question , then I can open a new one.
I actually need the average as well between "totals Job " and "Mode", can you tell me what lines I need to add in my code.
Thanks in advance.
David

byundt

David,
I added AVERAGE to the code, with two decimal places.

Private Sub CommandButton1_Click()
    Dim wb1 As Workbook
    Dim ws As Worksheet, ws1 As Worksheet
    Dim LastRowWs As Long, c1 As Long, i As Long, LstRw As Long
    Dim Rng1 As Range, Rng2 As Range
    Dim Head1a As Boolean, Head1b As Boolean, Head1c As Boolean
    Dim Head2a As Boolean, Head2b As Boolean
    
    Application.ScreenUpdating = False
    Set wb1 = Workbooks.Open(FilePath)
    Set ws1 = wb1.Sheets.Add(after:=wb1.Sheets(Sheets.Count))
    ws1.Name = "Summary"
    ws1.Range("A1:E1") = Array("SHEETNAME", "MEDIAN", "MODE", "AVERAGE", "TOTAL JOB:")
    
    LstRw = 2
    
    For Each ws In wb1.Worksheets
        If ws.Name <> "Summary" Then
            With ws
                Head1a = False: Head1b = False: Head1c = False
                Head2a = False: Head2b = False
                LastRowWs = .Range("A" & .Rows.Count).End(xlUp).Row
                c1 = .Cells(1, .Columns.Count).End(xlToLeft).Column + 1
                .Cells(1, c1) = headerText
                
                '~~> Check for HeaderText1a
                For i = 1 To c1 - 1
                    If InStr(1, .Cells(1, i).Value, HeaderText1a, vbTextCompare) Then
                        Head1a = True
                        Set Rng1 = .Cells(1, i)
                        Exit For
                    End If
                Next i
                
                '~~> Check for HeaderText1b
                For i = 1 To c1 - 1
                    If InStr(1, .Cells(1, i).Value, HeaderText1b, vbTextCompare) Then
                        Head1b = True
                        Set Rng1 = .Cells(1, i)
                        Exit For
                    End If
                Next i
                
                '~~> Check for HeaderText1c
                If Head1a = True Or Head1b = True Then
                    For i = 1 To c1 - 1
                        If InStr(1, .Cells(1, i).Value, HeaderText1c, vbTextCompare) Then
                            Head1c = True
                            Set Rng2 = .Cells(1, i)
                            Exit For
                        End If
                    Next i
                End If
                
                '~~> Check for HeaderText2a if the above is not found
                If Head1c = False Then
                    For i = 1 To c1 - 1
                        If InStr(1, .Cells(1, i).Value, HeaderText2a, vbTextCompare) Then
                            Head2a = True
                            Set Rng1 = .Cells(1, i)
                            Exit For
                        End If
                     Next i
                End If
                
                '~~> Check for HeaderText2b
                If Head2a = True Then
                    For i = 1 To c1 - 1
                        If InStr(1, .Cells(1, i).Value, HeaderText2b, vbTextCompare) Then
                            Head2a = True
                            Set Rng2 = .Cells(1, i)
                            Exit For
                        End If
                    Next i
                End If
                
                .Cells(2, c1).Formula = "=ABS(NETWORKDAYS(" & Replace(Rng1.Offset(1).Address, "$", "") & _
                                        "," & _
                                        Replace(Rng2.Offset(1).Address, "$", "") & _
                                        "))"
                
                On Error Resume Next
                .Cells(2, c1).AutoFill Destination:=.Range(.Cells(2, c1).Address & ":" & .Cells(LastRowWs, c1).Address), Type:=xlFillDefault
                On Error GoTo 0
                .Cells(LastRowWs + 1, c1 - 1) = "MEDIAN"
                .Cells(LastRowWs + 1, c1).Formula = "=MEDIAN(" & .Cells(2, c1).Address & ":" & .Cells(LastRowWs, c1).Address & ")"
                .Cells(LastRowWs + 2, c1 - 1) = "MODE"
                .Cells(LastRowWs + 2, c1).Formula = "=MODE(" & .Cells(2, c1).Address & ":" & .Cells(LastRowWs, c1).Address & ")"
                .Cells(LastRowWs + 3, c1 - 1) = "AVERAGE"
                .Cells(LastRowWs + 3, c1).Formula = "=AVERAGE(" & .Cells(2, c1).Address & ":" & .Cells(LastRowWs, c1).Address & ")"
                .Cells(LastRowWs + 3, c1).NumberFormat = "#.00"
                .Cells(LastRowWs + 4, c1 - 1) = "TOTAL JOB:"
                .Cells(LastRowWs + 4, c1).Formula = "=COUNT(" & .Cells(2, c1).Address & ":" & .Cells(LastRowWs, c1).Address & ")"
                .Cells.EntireColumn.AutoFit
                
                ws1.Cells(LstRw, 1) = .Name
                ws1.Cells(LstRw, 4).NumberFormat = "#.00"
                ws1.Cells(LstRw, 2).Resize(1, 4) = Application.Transpose(.Cells(LastRowWs + 1, c1).Resize(4, 1).Value)
                LstRw = LstRw + 1
            End With
        End If
    Next
    ws1.Cells.EntireColumn.AutoFit
'    wb1.Close savechanges = True
    Application.ScreenUpdating = True
    MsgBox "Done"
End Sub

Open in new window

Brad

taverny

ASKER

That is perfect , thank you again Brad , I think I understood how you do it.