?
Solved

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

Posted on 2013-05-30
3
Medium Priority
?
300 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
  • 2
3 Comments
 
LVL 17

Accepted Solution

by:
andrewssd3 earned 2000 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

Free Tool: Site Down Detector

Helpful to verify reports of your own downtime, or to double check a downed website you are trying to access.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

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

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…
After seeing numerous questions for Dynamic Data Validation I notice that most have used Visual Basic to solve the problem. This suggestion is purely formula based and can be used in multiple rows.
This Micro Tutorial demonstrates using Microsoft Excel pivot tables, how to reverse engineer competitors' marketing strategies through backlinks.
This Micro Tutorial will demonstrate in Microsoft Excel how to add style and sexy appeal to horizontal bar charts.

601 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