Solved

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

Posted on 2013-05-30
3
283 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 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

Industry Leaders: 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!

Question has a verified solution.

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

Suggested Solutions

This article descibes how to create a connection between Excel and SAP and how to move data from Excel to SAP or the other way around.
Do you use a spreadsheet like Microsoft's Excel?  Have you ever wanted to link out to a non excel file on your computer or network drive?  This is the way I found to do it!
This Micro Tutorial will demonstrate in Google Sheets how to use the HYPERLINK function to create live links inside your spreadsheet.
Finds all prime numbers in a range requested and places them in a public primes() array. I've demostrated a template size of 30 (2 * 3 * 5) but larger templates can be built such 210  (2 * 3 * 5 * 7) or 2310  (2 * 3 * 5 * 7 * 11). The larger templa‚Ķ

685 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