Go Premium for a chance to win a PS4. Enter to Win

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 298
  • Last Modified:

How can I adjust code from previous answer to only paste values?

I have a previously answered question that was answered wonderfully. However, at this point, I would like to adjust the code to have it only paste the values from Sheet 1 to Sheet 2.  Currently, I have formulas that are being copied and I would prefer values only.

Thanks!

http://www.experts-exchange.com/Software/Office_Productivity/Office_Suites/MS_Office/Excel/Q_28084040.html

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

    Dim URL As String, strEmail As String, strSubject As String, strBody As String
    Dim cel As Range, rg As Range, targ As Range, rg2 As Range      '*****Brad added declaration of rg to this statement
    If Sh.Name <> "Sheet1" Then Exit Sub
    
    Set targ = Intersect(Target, Range("I:I"))
    If targ Is Nothing Then Exit Sub
    
    For Each cel In targ.Cells
        If cel.Value = "B" Then
            Application.EnableEvents = False
            If ValidateColumnI(cel) Then
                strEmail = Range("$K" & Right(cel.Address, 2)).Value
                strSubject = "Job Completed"
                strBody = "Completion Date" & ": " & cel.EntireRow.Cells(1, "O").Value & vbLf & _
                        ", Resolution Code" & ": " & cel.EntireRow.Cells(1, "P").Value & vbLf & _
                        ", Tech #" & ": " & cel.EntireRow.Cells(1, "Q").Value
                strURL = "mailto:" & strEmail & "?subject=" & strSubject & "&body=" & strBody
                ShellExecute 0&, vbNullString, strURL, vbNullString, vbNullString, vbNormalFocus
                With Worksheets("Sheet2")
                    Set rg2 = .UsedRange
                    Set rg2 = rg2.Cells(rg2.Rows.Count + 1, 1).EntireRow
                    cel.EntireRow.Cut rg2
                    'cel.EntireRow.Delete                                       '*****Brad commented this line out
                End With
                Set rg = Sh.UsedRange                                           '*****Brad added this statement
                rg.Sort Key1:=Range("J1"), Order1:=xlAscending, Header:=xlYes   '*****Brad added this statement
            Else
                cel.Value = ""  'Didn't pass validation, so undo the selection of "B"
            End If
            Application.EnableEvents = True
        End If
    Next
End Sub 

Open in new window

0
Dominator1025
Asked:
Dominator1025
  • 2
1 Solution
 
andrewssd3Commented:
Try this:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

    Dim URL As String, strEmail As String, strSubject As String, strBody As String
    Dim cel As Range, rg As Range, targ As Range, rg2 As Range      '*****Brad added declaration of rg to this statement
    If Sh.Name <> "Sheet1" Then Exit Sub
    
    Set targ = Intersect(Target, Range("I:I"))
    If targ Is Nothing Then Exit Sub
    
    For Each cel In targ.Cells
        If cel.Value = "B" Then
            Application.EnableEvents = False
            If ValidateColumnI(cel) Then
                strEmail = Range("$K" & Right(cel.Address, 2)).Value
                strSubject = "Job Completed"
                strBody = "Completion Date" & ": " & cel.EntireRow.Cells(1, "O").Value & vbLf & _
                        ", Resolution Code" & ": " & cel.EntireRow.Cells(1, "P").Value & vbLf & _
                        ", Tech #" & ": " & cel.EntireRow.Cells(1, "Q").Value
                strURL = "mailto:" & strEmail & "?subject=" & strSubject & "&body=" & strBody
                ShellExecute 0&, vbNullString, strURL, vbNullString, vbNullString, vbNormalFocus
                With Worksheets("Sheet2")
                    Set rg2 = .UsedRange
                    Set rg2 = rg2.Cells(rg2.Rows.Count + 1, 1).EntireRow
                    rg2.Value = cel.EntireRow.Value
                    cel.EntireRow.Delete  
                End With
                Set rg = Sh.UsedRange                                           '*****Brad added this statement
                rg.Sort Key1:=Range("J1"), Order1:=xlAscending, Header:=xlYes   '*****Brad added this statement
            Else
                cel.Value = ""  'Didn't pass validation, so undo the selection of "B"
            End If
            Application.EnableEvents = True
        End If
    Next
End Sub 

Open in new window

0
 
Dominator1025Author Commented:
Thanks Andrew. Did you only change line 24?
0
 
andrewssd3Commented:
Yes, and I reinstated the next line to delete it as you're no longer using Cut
0

Featured Post

Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now