• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

not able to calculate formula to all rows

Hi Pcosta,

Thanks for you help and suggestions but i am not able to make it Dynamic getting many errors ..so what i have done is i replicated the data at home and created MACRO and made changes what i know and attached all documents so that you can check and help me in making it Dynamic.

i have attached instruction document how this macro has been created and all the steps for preparing the report

please help in this as its very Big Report and very important as it consumes lot of time to prepare it.

let me know if you need more info.

Thanks in advance.
 

Attachments

  • MACROCRM_TESTING.xlsm
    568.1 KB · Views: 1
  • RAW_DATA.xlsx
    105 KB · Views: 4
  • Template_backup.xlsx
    13.4 KB · Views: 1
  • Instructions.docx
    16.6 KB · Views: 4
Hi,

Try the attached file... run the "Report" subroutine and wait for the "Report complete!" message.

Note: You don't need to open the RAW_DATA file first. The macro will prompt you to select it from a dialog box. Just open the "Template" and run the code... if I didn't mess up it should work as intended.

Hope this helps
 

Attachments

  • Template_backup.xlsm
    34.9 KB · Views: 12
Hi Pcosta,

Excellent !!!!! its working perfectly and will test this for 2 more days with different data.. it took time to reply you because i am trying to understand how you wrote the code... i didnt expected the reply from you today but i am very happy that you have replied with solution .. i am very thankful to you....

only one question to you....as we are copying multiple data in sheets i don't think they overlap .. i saw there is 2 rows gap in between data ....
 
narsing rao said:
Hi Pcosta,

Excellent !!!!! its working perfectly and will test this for 2 more days with different data.. it took time to reply you because i am trying to understand how you wrote the code... i didnt expected the reply from you today but i am very happy that you have replied with solution .. i am very thankful to you....

only one question to you....as we are copying multiple data in sheets i don't think they overlap .. i saw there is 2 rows gap in between data ....
Click to expand...
Hi,

You are welcome :)... test it out thoroughly and let me know for any concerns.

About your question... it won't overlap. When copying from Production calls and Non-Production calls, for instance, to the same destination, it will leave a 2 row gap between both sets of data, similar to the example provided. That gap isn't fixed, i.e., I didn't specify where it should start pasting the second set of data... it will dynamically look for the previous data and paste 3 rows below it.
 
Hi Pcosta,

i checked the report and its working perfectly.

Thanks a Ton for sparing your time and preparing it.

i don't know to what extent i can take your help but i have few more reports like this which i am trying to prepare using macros. they have some quarterly and half yearly calls calculations for which dates keep changing every quarter.

Thanks once again for your valuable time .

your :awesome:.
 
Hi Pcosta,

i need small change the report.

Code: 
lrow = Sheets(3).UsedRange.Rows.Count
    For Each c In Sheets(3).Range("M2:M" & lrow)
        If c > 0 And c <= 24 And IsInArray(c.Offset(, -2), brr) = True Then
            c.EntireRow.Copy Sheets(11).Cells(Rows.Count, 1).End(xlUp).Offset(1)
        End If
    Next c

    Sheets(1).Rows(1).Copy Sheets(11).Cells(Rows.Count, 1).End(xlUp).Offset(3)
    lrow = Sheets(4).UsedRange.Rows.Count
    For Each c In Sheets(4).Range("M2:M" & lrow)
        If c > 0 And c <= 24 And IsInArray(c.Offset(, -2), brr) = True Then
            c.EntireRow.Copy Sheets(11).Cells(Rows.Count, 1).End(xlUp).Offset(1)
        End If


and below we have calculated at column(M)= N2 - O2
but for sheet 11 the formula should be (M) = O2-N2 how to do this.
Code: 
Dst.Activate
    lrow = Sheets(1).UsedRange.Rows.Count
    Sheets(1).Range("Q:T,W:AD").Delete
    Sheets(1).Columns("M:M").Insert Shift:=xlToRight
    Sheets(1).Range("M2").Formula = "=N2-O2"
    Sheets(1).Range("M2:M" & lrow).FillDown
    Sheets(1).Range("M1").Value = "SLA HRS LEFT"
 
Hi,

If by sheet 11 you mean the "7.Breached Today" sheet, replace code with:
Code: 
Sub Report()

    Application.ScreenUpdating = False

    Dim Src, Dst As Workbook
    Dim c As Range
    Dim lrow, i As Integer
    Dim SrcName, arr(9), brr(10) As String
  
    Set Dst = ActiveWorkbook
  
    SrcName = GetFile("C:\")
    If SrcName = "" Then
        MsgBox "Canceled by user request!", vbInformation
        Exit Sub
    End If
  
    Workbooks.Open SrcName
    Set Src = ActiveWorkbook
  
    arr(0) = "WIP"
    arr(1) = "With Assignee"
    arr(2) = "With CCB Approver"
    arr(3) = "With CCB Approver After Patch Initiation"
    arr(4) = "With Reviewer For Clarification"
    arr(5) = "Initiation"
    arr(6) = "With Support Team for Ownership"
    arr(7) = "With Release Manager Team For RCD Approval"
    arr(8) = "With Reviewer For Patch"
    arr(9) = "With Reviewer For Closure"

    brr(0) = "WIP"
    brr(1) = "With Assignee"
    brr(2) = "With Requestor For Clarification"
    brr(3) = "With CCB Approver"
    brr(4) = "With CCB Approver After Patch Initiation"
    brr(5) = "With Reviewer For Clarification"
    brr(6) = "Initiation"
    brr(7) = "With Support Team for Ownership"
    brr(8) = "With Release Manager Team For RCD Approval"
    brr(9) = "With Reviewer For Patch"
    brr(10) = "With Reviewer For Closure"
  
    Src.Sheets(1).UsedRange.Copy Dst.Sheets(1).Cells(1, 1)
    Src.Close False

    Dst.Activate
    lrow = Sheets(1).UsedRange.Rows.Count
    Sheets(1).Range("Q:T,W:AD").Delete
    Sheets(1).Columns("M:M").Insert Shift:=xlToRight
    Sheets(1).Range("M2").Formula = "=N2-O2"
    Sheets(1).Range("M2:M" & lrow).FillDown
    Sheets(1).Range("M1").Value = "SLA HRS LEFT"
  
    For i = 2 To Sheets.Count
        With Sheets(1).Rows(1)
            .Copy Sheets(i).Rows(1)
        End With
    Next i

    For Each c In Sheets(1).Range("E2:E" & lrow)
        If InStr(c, "FINCRM 10.3.") = 0 And InStr(c.Offset(, -3), "ITL") = 0 And InStr(c.Offset(, -3), "URALSIB") = 0 And InStr(c.Offset(, 14), "CUSTOMIZATION_ISSUE") = 0 And InStr(c.Offset(, 14), "SIT_CUSTOMISATION") = 0 And InStr(c.Offset(, 14), "CUSTOMISATION REQUEST") = 0 Then
            c.EntireRow.Copy Sheets(2).Cells(Rows.Count, 1).End(xlUp).Offset(1)
        End If
    Next c

    lrow = Sheets(2).UsedRange.Rows.Count
    For Each c In Sheets(2).Range("R2:R" & lrow)
        If c = "PRODUCTION" Then
            c.EntireRow.Copy Sheets(3).Cells(Rows.Count, 1).End(xlUp).Offset(1)
        End If
    Next c

    For Each c In Sheets(2).Range("R2:R" & lrow)
        If c <> "PRODUCTION" Then
            c.EntireRow.Copy Sheets(4).Cells(Rows.Count, 1).End(xlUp).Offset(1)
        End If
    Next c

    lrow = Sheets(3).UsedRange.Rows.Count
    For Each c In Sheets(3).Range("M2:M" & lrow)
        If c > 0 And c <= 120 And IsInArray(c.Offset(, -2), arr) = True Then
            c.EntireRow.Copy Sheets(5).Cells(Rows.Count, 1).End(xlUp).Offset(1)
        End If
    Next c
  
    Sheets(1).Rows(1).Copy Sheets(5).Cells(Rows.Count, 1).End(xlUp).Offset(3)
    For Each c In Sheets(3).Range("M2:M" & lrow)
        If c > 0 And c <= 120 And c.Offset(, -2) = "With Requestor For Clarification" Then
            c.EntireRow.Copy Sheets(5).Cells(Rows.Count, 1).End(xlUp).Offset(1)
        End If
    Next c
  
    lrow = Sheets(4).UsedRange.Rows.Count
    For Each c In Sheets(4).Range("M2:M" & lrow)
        If c > 0 And c <= 120 And IsInArray(c.Offset(, -2), arr) = True Then
            c.EntireRow.Copy Sheets(6).Cells(Rows.Count, 1).End(xlUp).Offset(1)
        End If
    Next c
  
    Sheets(1).Rows(1).Copy Sheets(6).Cells(Rows.Count, 1).End(xlUp).Offset(3)
    For Each c In Sheets(4).Range("M2:M" & lrow)
        If c > 0 And c <= 120 And c.Offset(, -2) = "With Requestor For Clarification" Then
            c.EntireRow.Copy Sheets(6).Cells(Rows.Count, 1).End(xlUp).Offset(1)
        End If
    Next c

    lrow = Sheets(3).UsedRange.Rows.Count
    For Each c In Sheets(3).Range("M2:M" & lrow)
        If c > 0 And c <= 48 And IsInArray(c.Offset(, -2), arr) = True Then
            c.EntireRow.Copy Sheets(7).Cells(Rows.Count, 1).End(xlUp).Offset(1)
        End If
    Next c
  
    Sheets(1).Rows(1).Copy Sheets(7).Cells(Rows.Count, 1).End(xlUp).Offset(3)
    For Each c In Sheets(3).Range("M2:M" & lrow)
        If c > 0 And c <= 48 And c.Offset(, -2) = "With Requestor For Clarification" Then
            c.EntireRow.Copy Sheets(7).Cells(Rows.Count, 1).End(xlUp).Offset(1)
        End If
    Next c

    lrow = Sheets(4).UsedRange.Rows.Count
    For Each c In Sheets(4).Range("M2:M" & lrow)
        If c > 0 And c <= 48 And IsInArray(c.Offset(, -2), arr) = True Then
            c.EntireRow.Copy Sheets(8).Cells(Rows.Count, 1).End(xlUp).Offset(1)
        End If
    Next c
  
    Sheets(1).Rows(1).Copy Sheets(8).Cells(Rows.Count, 1).End(xlUp).Offset(3)
    For Each c In Sheets(4).Range("M2:M" & lrow)
        If c > 0 And c <= 48 And c.Offset(, -2) = "With Requestor For Clarification" Then
            c.EntireRow.Copy Sheets(8).Cells(Rows.Count, 1).End(xlUp).Offset(1)
        End If
    Next c
  
    lrow = Sheets(3).UsedRange.Rows.Count
    For Each c In Sheets(3).Range("K2:K" & lrow)
        If c = "With CCB Approver" Then
            c.EntireRow.Copy Sheets(9).Cells(Rows.Count, 1).End(xlUp).Offset(1)
        End If
    Next c
  
    lrow = Sheets(4).UsedRange.Rows.Count
    For Each c In Sheets(4).Range("K2:K" & lrow)
        If c = "With CCB Approver" Then
            c.EntireRow.Copy Sheets(10).Cells(Rows.Count, 1).End(xlUp).Offset(1)
        End If
    Next c

    lrow = Sheets(3).UsedRange.Rows.Count
    For Each c In Sheets(3).Range("M2:M" & lrow)
        If c > 0 And c <= 24 And IsInArray(c.Offset(, -2), brr) = True Then
            c.EntireRow.Copy Sheets(11).Cells(Rows.Count, 1).End(xlUp).Offset(1)
        End If
    Next c

    Sheets(1).Rows(1).Copy Sheets(11).Cells(Rows.Count, 1).End(xlUp).Offset(3)
    lrow = Sheets(4).UsedRange.Rows.Count
    For Each c In Sheets(4).Range("M2:M" & lrow)
        If c > 0 And c <= 24 And IsInArray(c.Offset(, -2), brr) = True Then
            c.EntireRow.Copy Sheets(11).Cells(Rows.Count, 1).End(xlUp).Offset(1)
        End If
    Next c
  
    lrow = Sheets(3).UsedRange.Rows.Count
    For Each c In Sheets(3).Range("Q2:Q" & lrow)
        If c = "Not Met" Then
            c.EntireRow.Copy Sheets(12).Cells(Rows.Count, 1).End(xlUp).Offset(1)
        End If
    Next c

    lrow = Sheets(4).UsedRange.Rows.Count
    For Each c In Sheets(4).Range("Q2:Q" & lrow)
        If c = "Not Met" Then
            c.EntireRow.Copy Sheets(13).Cells(Rows.Count, 1).End(xlUp).Offset(1)
        End If
    Next c
  
    For Each c In Sheets(11).Columns("M:M").SpecialCells(xlCellTypeFormulas)
        c.Formula = "=O2-N2"
    Next c
  
    MsgBox "Report complete!", vbInformation

    Application.ScreenUpdating = True

End Sub

Private Function IsInArray(valToBeFound As Variant, arr As Variant) As Boolean

Dim element As Variant
On Error GoTo IsInArrayError: 'array is empty
    For Each element In arr
        If element = valToBeFound Then
            IsInArray = True
            Exit Function
        End If
    Next element
Exit Function
IsInArrayError:
On Error GoTo 0
IsInArray = False

End Function

Function GetFile(strPath As String) As String

    Dim File As FileDialog
    Dim sItem As String
    Set File = Application.FileDialog(msoFileDialogFilePicker)
    With File
        .Title = "Select RAW DATA file"
        .AllowMultiSelect = False
        .Filters.Clear
        .Filters.Add "Excel files only", "*.xls; *.xlsx, *.xlsm"
        .InitialFileName = strPath
        If .Show <> -1 Then GoTo NextCode
        sItem = .SelectedItems(1)
    End With
NextCode:
    GetFile = sItem
    Set File = Nothing

End Function

What I did was go through each cell with formula in column M of sheet 11, replacing the formula with "=O2-N2".
Just so you can understand better, below you can find the specific lines I added in the code above:
Code: 
    For Each c In Sheets(11).Columns("M:M").SpecialCells(xlCellTypeFormulas)
        c.Formula = "=O2-N2"
    Next c
 
Thanks for the Reply ....Yes i saw the code changes you have done...but previously we have appluied the formula in sheet one and copied data to sheet 3 and once again applied the conditions in sheet3 and copied to sheet11 ..but now we are directly appying formula in sheet11 ...one clarification needed does it check the condition

Code: 
If c > 0 And c <= 24 And IsInArray(c.Offset(, -2), brr) = TrueThen
            c.EntireRow.Copy Sheets(11).Cells(Rows.Count, 1).End(xlUp).Offset(1)
       EndIf

and how it will copy the same data in sheet11
 
just one info .....for example N2= 14 and O2=13, ( M=N2-O2) M= 1 if we do reverse it will be -1 , can we do all plus values to minus (- ) and all minus values to (+)...if i am not wrong...
 
Hi Pcosta,

I have searched in the net and found something called (c.Value = -c.Value) and done below changes ....let me know what i have done is right or wrong.


Code: 
 lrow = Sheets(3).UsedRange.Rows.Count
    For Each c In Sheets(3).Range("M2:M" & lrow)
    c.Value = -c.Value
     If c > 0 And c <= 24 And IsInArray(c.Offset(, -2), brr) = True Then
            c.EntireRow.Copy Sheets(11).Cells(Rows.Count,1).End(xlUp).Offset(1)
        End If
        c.Value = -c.Value
    Next c

    Sheets(1).Rows(1).Copy Sheets(11).Cells(Rows.Count,1).End(xlUp).Offset(3)
    lrow = Sheets(4).UsedRange.Rows.Count
    For Each c In Sheets(4).Range("M2:M" & lrow)
    c.Value = -c.Value
   
        If c > 0 And c <= 24 And IsInArray(c.Offset(, -2), brr) = True Then
            c.EntireRow.Copy Sheets(11).Cells(Rows.Count,1).End(xlUp).Offset(1)
        End If
        c.Value = -c.Value
    Next c
 
narsing rao said:
Thanks for the Reply ....Yes i saw the code changes you have done...but previously we have appluied the formula in sheet one and copied data to sheet 3 and once again applied the conditions in sheet3 and copied to sheet11 ..but now we are directly appying formula in sheet11 ...one clarification needed does it check the condition

Code: 
If c > 0 And c <= 24 And IsInArray(c.Offset(, -2), brr) = TrueThen
            c.EntireRow.Copy Sheets(11).Cells(Rows.Count, 1).End(xlUp).Offset(1)
       EndIf

and how it will copy the same data in sheet11
Click to expand...
Hi,

I see what you mean... My apologies, I totally forgot about that.
Also, this last code I posted is incorrect as I didn't copy the formula down to the other cells, meaning that sheet 11 (column M) would get O2-N2 in all rows and not O2-N2, O3-N3 and so on.

Code revised below:
Code: 
Sub Report()

    Application.ScreenUpdating = False

    Dim Src, Dst As Workbook
    Dim c As Range
    Dim lrow, i As Integer
    Dim SrcName, arr(9), brr(10) As String

    Set Dst = ActiveWorkbook

    SrcName = GetFile("C:\")
    If SrcName = "" Then
        MsgBox "Canceled by user request!", vbInformation
        Exit Sub
    End If

    Workbooks.Open SrcName
    Set Src = ActiveWorkbook

    arr(0) = "WIP"
    arr(1) = "With Assignee"
    arr(2) = "With CCB Approver"
    arr(3) = "With CCB Approver After Patch Initiation"
    arr(4) = "With Reviewer For Clarification"
    arr(5) = "Initiation"
    arr(6) = "With Support Team for Ownership"
    arr(7) = "With Release Manager Team For RCD Approval"
    arr(8) = "With Reviewer For Patch"
    arr(9) = "With Reviewer For Closure"

    brr(0) = "WIP"
    brr(1) = "With Assignee"
    brr(2) = "With Requestor For Clarification"
    brr(3) = "With CCB Approver"
    brr(4) = "With CCB Approver After Patch Initiation"
    brr(5) = "With Reviewer For Clarification"
    brr(6) = "Initiation"
    brr(7) = "With Support Team for Ownership"
    brr(8) = "With Release Manager Team For RCD Approval"
    brr(9) = "With Reviewer For Patch"
    brr(10) = "With Reviewer For Closure"

    Src.Sheets(1).UsedRange.Copy Dst.Sheets(1).Cells(1, 1)
    Src.Close False

    Dst.Activate
    lrow = Sheets(1).UsedRange.Rows.Count
    Sheets(1).Range("Q:T,W:AD").Delete
    Sheets(1).Columns("M:M").Insert Shift:=xlToRight
    Sheets(1).Range("M2").Formula = "=N2-O2"
    Sheets(1).Range("M2:M" & lrow).FillDown
    Sheets(1).Range("M1").Value = "SLA HRS LEFT"

    For i = 2 To Sheets.Count
        With Sheets(1).Rows(1)
            .Copy Sheets(i).Rows(1)
        End With
    Next i

    For Each c In Sheets(1).Range("E2:E" & lrow)
        If InStr(c, "FINCRM 10.3.") = 0 And InStr(c.Offset(, -3), "ITL") = 0 And InStr(c.Offset(, -3), "URALSIB") = 0 And InStr(c.Offset(, 14), "CUSTOMIZATION_ISSUE") = 0 And InStr(c.Offset(, 14), "SIT_CUSTOMISATION") = 0 And InStr(c.Offset(, 14), "CUSTOMISATION REQUEST") = 0 Then
            c.EntireRow.Copy Sheets(2).Cells(Rows.Count, 1).End(xlUp).Offset(1)
        End If
    Next c

    lrow = Sheets(2).UsedRange.Rows.Count
    For Each c In Sheets(2).Range("R2:R" & lrow)
        If c = "PRODUCTION" Then
            c.EntireRow.Copy Sheets(3).Cells(Rows.Count, 1).End(xlUp).Offset(1)
        End If
    Next c

    For Each c In Sheets(2).Range("R2:R" & lrow)
        If c <> "PRODUCTION" Then
            c.EntireRow.Copy Sheets(4).Cells(Rows.Count, 1).End(xlUp).Offset(1)
        End If
    Next c

    lrow = Sheets(3).UsedRange.Rows.Count
    For Each c In Sheets(3).Range("M2:M" & lrow)
        If c > 0 And c <= 120 And IsInArray(c.Offset(, -2), arr) = True Then
            c.EntireRow.Copy Sheets(5).Cells(Rows.Count, 1).End(xlUp).Offset(1)
        End If
    Next c

    Sheets(1).Rows(1).Copy Sheets(5).Cells(Rows.Count, 1).End(xlUp).Offset(3)
    For Each c In Sheets(3).Range("M2:M" & lrow)
        If c > 0 And c <= 120 And c.Offset(, -2) = "With Requestor For Clarification" Then
            c.EntireRow.Copy Sheets(5).Cells(Rows.Count, 1).End(xlUp).Offset(1)
        End If
    Next c

    lrow = Sheets(4).UsedRange.Rows.Count
    For Each c In Sheets(4).Range("M2:M" & lrow)
        If c > 0 And c <= 120 And IsInArray(c.Offset(, -2), arr) = True Then
            c.EntireRow.Copy Sheets(6).Cells(Rows.Count, 1).End(xlUp).Offset(1)
        End If
    Next c

    Sheets(1).Rows(1).Copy Sheets(6).Cells(Rows.Count, 1).End(xlUp).Offset(3)
    For Each c In Sheets(4).Range("M2:M" & lrow)
        If c > 0 And c <= 120 And c.Offset(, -2) = "With Requestor For Clarification" Then
            c.EntireRow.Copy Sheets(6).Cells(Rows.Count, 1).End(xlUp).Offset(1)
        End If
    Next c

    lrow = Sheets(3).UsedRange.Rows.Count
    For Each c In Sheets(3).Range("M2:M" & lrow)
        If c > 0 And c <= 48 And IsInArray(c.Offset(, -2), arr) = True Then
            c.EntireRow.Copy Sheets(7).Cells(Rows.Count, 1).End(xlUp).Offset(1)
        End If
    Next c

    Sheets(1).Rows(1).Copy Sheets(7).Cells(Rows.Count, 1).End(xlUp).Offset(3)
    For Each c In Sheets(3).Range("M2:M" & lrow)
        If c > 0 And c <= 48 And c.Offset(, -2) = "With Requestor For Clarification" Then
            c.EntireRow.Copy Sheets(7).Cells(Rows.Count, 1).End(xlUp).Offset(1)
        End If
    Next c

    lrow = Sheets(4).UsedRange.Rows.Count
    For Each c In Sheets(4).Range("M2:M" & lrow)
        If c > 0 And c <= 48 And IsInArray(c.Offset(, -2), arr) = True Then
            c.EntireRow.Copy Sheets(8).Cells(Rows.Count, 1).End(xlUp).Offset(1)
        End If
    Next c

    Sheets(1).Rows(1).Copy Sheets(8).Cells(Rows.Count, 1).End(xlUp).Offset(3)
    For Each c In Sheets(4).Range("M2:M" & lrow)
        If c > 0 And c <= 48 And c.Offset(, -2) = "With Requestor For Clarification" Then
            c.EntireRow.Copy Sheets(8).Cells(Rows.Count, 1).End(xlUp).Offset(1)
        End If
    Next c

    lrow = Sheets(3).UsedRange.Rows.Count
    For Each c In Sheets(3).Range("K2:K" & lrow)
        If c = "With CCB Approver" Then
            c.EntireRow.Copy Sheets(9).Cells(Rows.Count, 1).End(xlUp).Offset(1)
        End If
    Next c

    lrow = Sheets(4).UsedRange.Rows.Count
    For Each c In Sheets(4).Range("K2:K" & lrow)
        If c = "With CCB Approver" Then
            c.EntireRow.Copy Sheets(10).Cells(Rows.Count, 1).End(xlUp).Offset(1)
        End If
    Next c

    lrow = Sheets(3).UsedRange.Rows.Count
    For Each c In Sheets(3).Range("M2:M" & lrow)
        If -c > 0 And -c <= 24 And IsInArray(c.Offset(, -2), brr) = True Then
            c.EntireRow.Copy Sheets(11).Cells(Rows.Count, 1).End(xlUp).Offset(1)
        End If
    Next c

    Sheets(1).Rows(1).Copy Sheets(11).Cells(Rows.Count, 1).End(xlUp).Offset(3)
    lrow = Sheets(4).UsedRange.Rows.Count
    For Each c In Sheets(4).Range("M2:M" & lrow)
        If -c > 0 And -c <= 24 And IsInArray(c.Offset(, -2), brr) = True Then
            c.EntireRow.Copy Sheets(11).Cells(Rows.Count, 1).End(xlUp).Offset(1)
        End If
    Next c

    lrow = Sheets(3).UsedRange.Rows.Count
    For Each c In Sheets(3).Range("Q2:Q" & lrow)
        If c = "Not Met" Then
            c.EntireRow.Copy Sheets(12).Cells(Rows.Count, 1).End(xlUp).Offset(1)
        End If
    Next c

    lrow = Sheets(4).UsedRange.Rows.Count
    For Each c In Sheets(4).Range("Q2:Q" & lrow)
        If c = "Not Met" Then
            c.EntireRow.Copy Sheets(13).Cells(Rows.Count, 1).End(xlUp).Offset(1)
        End If
    Next c

    For Each c In Sheets(11).Columns("M:M").SpecialCells(xlCellTypeFormulas)
        c.FormulaR1C1 = "=rc[2]-rc[1]"
    Next c

    MsgBox "Report complete!", vbInformation

    Application.ScreenUpdating = True

End Sub

Private Function IsInArray(valToBeFound As Variant, arr As Variant) As Boolean

Dim element As Variant
On Error GoTo IsInArrayError: 'array is empty
    For Each element In arr
        If element = valToBeFound Then
            IsInArray = True
            Exit Function
        End If
    Next element
Exit Function
IsInArrayError:
On Error GoTo 0
IsInArray = False

End Function

Function GetFile(strPath As String) As String

    Dim File As FileDialog
    Dim sItem As String
    Set File = Application.FileDialog(msoFileDialogFilePicker)
    With File
        .Title = "Select RAW DATA file"
        .AllowMultiSelect = False
        .Filters.Clear
        .Filters.Add "Excel files only", "*.xls; *.xlsx, *.xlsm"
        .InitialFileName = strPath
        If .Show <> -1 Then GoTo NextCode
        sItem = .SelectedItems(1)
    End With
NextCode:
    GetFile = sItem
    Set File = Nothing

End Function

It should be OK now, sorry again :(

I have searched in the net and found something called (c.Value = -c.Value) and done below changes ....let me know what i have done is right or wrong.
Click to expand...

That is correct, c.value=-c.value is the same as O-N. However, the way you implemented it is not. You see, when you use the value method here, it will replace the formula and convert the cells content to value (similar to "Paste Values").
Since this is the last copy/paste operation involving the column M of sheet 3 and 4, it would probably work the same way, but if there were more operations using those values you would need to change them back to the original values.
So, what I did instead was use "-c>0 and -c<=24" which is the same as saying "O-N>0 and O-N<=24".
Then I changed the formula in the destination (sheet 11), just so it matches the criteria used.
 
Last edited:
It seems to be working correct.......Thanks a lot Pcosta.... if possible can you please look into my other post....i have another same kind of report with Summary report in that i have 8 sheets from that i am trying to make one Pivot table or i will combine all pivot table in summary sheet.:)
 
narsing rao said:
It seems to be working correct.......Thanks a lot Pcosta.... if possible can you please look into my other post....i have another same kind of report with Summary report in that i have 8 sheets from that i am trying to make one Pivot table or i will combine all pivot table in summary sheet.:)
Click to expand...

Don't mention it ;)
About the other thread, I will take a look at it and if I have any suggestion I will post there.
 
You must log in or register to reply here.
Back
Top