0
votes

I have the following code it is meant to have the

  1. values of Cells K50: AO50 in each sheet equal to K73:AO73 multiplied by Opex (which is variable).
  2. Paste it into a new sheet and then
  3. Go back to the sheet it took the values from and undo the changes for all the sheets in workbook so the values within each individual sheet remain untouched.

The code I wrote first gives me a type mismatch error and also I do not how to do undo the changes in the original worksheets.

Option Explicit

Sub FinalGO()

Application.ScreenUpdating = False
' When using turning ScreenUpdating off, it is wise to use an Error Handler,
' so when an error occurs, it will get turned on again.
On Error GoTo ErrorHandler

Dim ws As Worksheet     ' Current Worksheet
Dim i As Long           ' Row (Cell) Counter
Dim strName As String   ' New Worksheet Name
Dim AMPM As String 'am or pm
Dim Opex As Integer

AMPM = Format(Now, "AM/PM")
Opex = InputBox("What is our incremental Opex ($)?", "Opex")

' Determine New Worksheet Name.
strName = "Summary " & Minute(Now) & "-" & Hour(Now) & AMPM & "-" & Day(Now) & "-" & Month(Now)

' In This Workbook (The Workbook Containing This Code)
With ThisWorkbook
     ' Check if New Worksheet already exists.
     On Error Resume Next
     Set ws = .Worksheets(strName)
     If Err Then  ' Does NOT exist.
          On Error GoTo 0
        Else      ' DOES exist.
          GoTo AlreadyDoneToday
     End If

     ' Reenable error handling.
     On Error GoTo ErrorHandler

    ' Add a New Worksheet to the last position in This Workbook.
    .Sheets.Add After:=.Sheets(.Sheets.Count)
    ' In the New Worksheet.
    With .Sheets(.Sheets.Count)
        ' Rename New Worksheet. If you already have used this code today,
        ' this line will produce an error. Delete the sheet or...
        .Name = strName
        ' Write to cell A1 in New Worksheet.
        .Cells(1, 1).Value = "Project Name"
        .Cells(1, 2).Value = "NPV"
        .Cells(1, 3).Value = "Total Capex"
        .Cells(1, 4).Value = "Augmentation Cost"
        .Cells(1, 5).Value = "Metering Cost"
        .Cells(1, 6).Value = "Total Opex"
        .Cells(1, 7).Value = "Total Revenue"

        ' Reset Row (Cells) Counter , because 1st already contains a value.
        i = 1
        ' Loop through worksheets of This Workbook (.Parent).
        For Each ws In .Parent.Worksheets
            ' Check the Name of the Current Worksheet.
            Select Case ws.Name
                ' Do Nothing.
                Case "Prices", "Home Page", "Model Digaram", _
                        "Validation & Checks", "Model Start-->", _
                        "Input|Assumptions", "Cost Assumption", "Index", "Model Diagram"

                Case Else

                      If ws.Range("I92").Value = "" Then

                            ws.Range("K50:KO50").Value = ws.Range("K73:AO73").Value * Opex

                            ws.Range("k49:AO49").Value = ws.Range("K72:AO72").Value * Opex

                         Else

                            ws.Range("K49:AO49").Value = ws.Range("K72:AO72").Value * Opex

             End If

                    ' Count Rows (Cells).
                    i = i + 1
                    ' Write name of Current Worksheet to cell in current
                    ' Row and first column of New Worksheet.
                    .Cells(i, 1).Value = ws.Name
                    If ws.Range("I106").Value = "" Then

                            .Cells(i, 2).Value = ws.Range("I108").Value

                                        Else

                            .Cells(i, 2).Value = ws.Range("I106").Value

                                        End If

                    .Cells(i, 3).Value = ws.Range("AQ39").Value
                    .Cells(i, 4).Value = ws.Range("AQ23").Value
                    .Cells(i, 5).Value = Cells(i, 3).Value - Cells(i, 4).Value
                    .Cells(i, 6).Value = ws.Range("AQ65").Value
                    .Cells(i, 7).Value = ws.Range("AQ95").Value

Cells.Select
Selection.NumberFormat = "$#,##0"
ActiveSheet.Range("B2:G30").Select
Application.CalculateFull



Dim lastrow As Long
lastrow = Cells(Rows.Count, 2).End(xlUp).Row
Range("A1:G" & lastrow).Sort key1:=Range("B2:B" & lastrow), _
order1:=xlDescending, Header:=xlYes



Success:

MsgBox "The operation finished successfully.", vbInformation, "Success"

SafeExit:

Application.ScreenUpdating = True

Exit Sub

AlreadyDoneToday:

MsgBox "You have already done this today.", vbExclamation, "Already done."
GoTo SafeExit

ErrorHandler:

MsgBox "An unexpected error occurred. Error '" & Err.Number & "': " _
        & Err.Description, vbCritical, "Error"
GoTo SafeExit

End Sub

1
I think ws.Range("K50:KO50").Value should be ws.Range("K50:AO50").Value?Siddharth Rout
Change the logic to 1. Copy the data to the new sheet. Let's call the data copied to the new sheet as rng. 2. Multiply the new rng with the variable and paste it over it self. .PasteSpecial Paste:=xlPasteValues, Operation:=xlMultiply allows this. This way you do not need to go back everytime to revert the originalSiddharth Rout

1 Answers

1
votes

You've left out a few parent worksheet references and did not exclude the new worksheet from the processing. I've corrected these and tightened up the code according to my own style.

Option Explicit

Sub FinalGO()
    'I disabled this for testing
    'Application.ScreenUpdating = False
    ' When using turning ScreenUpdating off, it is wise to use an Error Handler,
    ' so when an error occurs, it will get turned on again.
    On Error GoTo ErrorHandler

    Dim ws As Worksheet     ' Current Worksheet
    Dim i As Long           ' Row (Cell) Counter
    Dim strName As String   ' New Worksheet Name
    Dim Opex As Long

    Opex = Application.InputBox(prompt:="What is our incremental Opex ($)?", Title:="Opex", Type:=xlNumbers)

    ' Determine New Worksheet Name.
    strName = Format(Now, "\S\u\m\m\a\r\y nn-hhAM/PM-dd-mm")

    ' In This Workbook (The Workbook Containing This Code)
    With ThisWorkbook

        ' Add a New Worksheet to the last position in This Workbook.
        With .Worksheets.Add(After:=.Sheets(.Sheets.Count))

            ' Rename New Worksheet. This is only an error if run twice within 1 minute.
            On Error GoTo AlreadyDoneToday
            .Name = strName
            On Error GoTo ErrorHandler

            ' Write headers in New Worksheet.
            .Cells(1, 1).Resize(1, 7) = Array("Project Name", "NPV", "Total Capex", "Augmentation Cost", _
                                              "Metering Cost", "Total Opex", "Total Revenue")


            ' Loop through worksheets of This Workbook (.Parent).
            For Each ws In .Parent.Worksheets

                ' Check the Name of the Current Worksheet.
                Select Case ws.Name
                    'don't write THIS worksheet or a few others
                    Case strName, "Home Page", "Model Digaram", "Validation & Checks", "Model Start-->", _
                         "Prices", "Input|Assumptions", "Cost Assumption", "Index", "Model Diagram"

                        ' Do Nothing.

                    Case Else

                        ' Count Rows (Cells).
                        i = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).Row

                        ' Write name of Current Worksheet to cell in current
                        ' Row and first column of New Worksheet.
                        .Cells(i, 1).Value = ws.Name
                        If ws.Range("I106").Value = "" Then
                            .Cells(i, 2).Value = ws.Range("I108").Value
                        Else
                            .Cells(i, 2).Value = ws.Range("I106").Value
                        End If

                        .Cells(i, 3).Value = ws.Range("AQ39").Value
                        .Cells(i, 4).Value = ws.Range("AQ23").Value
                        .Cells(i, 5).FormulaR1C1 = "=rc3-rc4"
                        .Cells(i, 6).Value = ws.Range("AQ65").Value
                        .Cells(i, 7).Value = ws.Range("AQ95").Value
                End Select
            Next ws
        End With
    End With


Success:
    MsgBox "The operation finished successfully.", vbInformation, "Success"

SafeExit:
    Application.ScreenUpdating = True

Exit Sub

AlreadyDoneToday:
    MsgBox "You have already done this minute.", vbExclamation, "Already done."
    Application.DisplayAlerts = False
    ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Delete
    Application.DisplayAlerts = True
    GoTo SafeExit

ErrorHandler:
    MsgBox "An unexpected error occurred. Error '" & Err.Number & "': " _
            & Err.Description, vbCritical, "Error"
    GoTo SafeExit

End Sub

One thing of note is that the code you wrote could be run twice on the same day but not twice within the same minute. If you truly want to avoid running twice the same day then additional modifications would be necessary for a fail safe exit.