Solved

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

Posted on 2013-05-30
3
286 Views
Last Modified: 2013-06-04
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
Comment
Question by:Dominator1025
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 2
3 Comments
 
LVL 17

Accepted Solution

by:
andrewssd3 earned 500 total points
ID: 39210038
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
 

Author Comment

by:Dominator1025
ID: 39211329
Thanks Andrew. Did you only change line 24?
0
 
LVL 17

Expert Comment

by:andrewssd3
ID: 39212557
Yes, and I reinstated the next line to delete it as you're no longer using Cut
0

Featured Post

Online Training Solution

Drastically shorten your training time with WalkMe's advanced online training solution that Guides your trainees to action. Forget about retraining and skyrocket knowledge retention rates.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This article will guide you to convert a grid from a picture into Excel format using Microsoft OneNote and no other 3rd party application.
Excel can be a tricky bit of software to get your head around. Whilst you’ll be able to eventually get to grips with the basic understanding of how to get by, there are a few Excel tips that not everybody will even know about let alone know how to d…
This Micro Tutorial demonstrates how to create Excel charts: column, area, line, bar, and scatter charts. Formatting tips are provided as well.
Although Jacob Bernoulli (1654-1705) has been credited as the creator of "Binomial Distribution Table", Gottfried Leibniz (1646-1716) did his dissertation on the subject in 1666; Leibniz you may recall is the co-inventor of "Calculus" and beat Isaac…

739 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question