Need small tweak to code - export values instead of formulas

Cyclops755

New Member
Joined
Jul 26, 2011
Messages
31
The workbook I'm working on contains the following code to export data from two tables on two separate sheets, and combine them on one sheet so that it can be referenced to a PVT. The code works wonderfully, but I've recently had to make a few changes to the workbook, and the way the code runs now, it exports the formulas associated with all the cells to the new sheet. How can I tweak this to export just the values to the new sheet?

Thanks a bunch!

Code:
Option Explicit

Sub CreateDataStorageNoDelete()
    Dim myLastM, myCountM, i1, j1, cr, LastRow1, LastCol1, LastRow2, LastCol2, LastRow3, LastCol3 As Long
    Dim myFormula1, myFormula2 As String
    Dim myST(1 To 3) As Object

'Declare sheets to be used as variables
    Set myST(1) = Sheets("Parts List")
    Set myST(2) = Sheets("Combine Build List")
    Set myST(3) = Sheets("Data Storage")
    
    Application.ScreenUpdating = False
        
'Make destination sheet visable
    Sheets("Data Storage").Visible = True
    
'Define the range on which Parts data exists
    LastCol1 = myST(1).Cells(1, Columns.Count).End(xlToLeft).Column
    LastRow1 = WorksheetFunction.Match("zzzzz", myST(1).Range("A:A"))
    
    
    myST(2).Select
    ActiveSheet.Unprotect ("Combine")
    
    LastCol2 = Cells(1, Columns.Count).End(xlToLeft).Column + 1
    LastRow2 = WorksheetFunction.Match("zzzzz", Range("A:A"))
    
    myLastM = 2 * LastCol2
    myFormula1 = "=IF(COLUMNS(C2:C[-" & (LastCol2 - 1) & "])>COUNTIF(RC2:RC" & LastCol2 & ",""a""),"""",INDEX(R1C2:R1C" & LastCol2 & _
        ",,LARGE((RC2:RC" & LastCol2 & "=""a"")*(COLUMN(R1C2:R1C" & LastCol2 & ")-COLUMN(R1C2)+1),COLUMNS(C2:C[-" & (LastCol2 - 1) & "]))))"
    Cells(2, LastCol2 + 1).FormulaArray = myFormula1
    Cells(2, LastCol2 + 1).Copy Destination:=Range(Cells(2, LastCol2 + 2), Cells(2, myLastM))
    Range(Cells(2, LastCol2 + 1), Cells(2, myLastM)).Copy Destination:=Range(Cells(3, LastCol2 + 1), Cells(LastRow2, myLastM))
    Range(Cells(2, myLastM + 1), Cells(LastRow2, myLastM + 1)).FormulaR1C1 = "=COUNTIF(RC2:RC" & LastCol2 & ",""a"")"
    'ActiveSheet.Protect ("Combine")
    
    myST(3).Select
    
    LastCol3 = Cells(1, Columns.Count).End(xlToLeft).Column
    
    If Cells(1, 1).Value = "" Then
        LastRow3 = 1
    Else
        LastRow3 = WorksheetFunction.Match("zzzzz", Range("A:A"))
    End If
        
    Range(Cells(1, 1), Cells(LastRow3, LastCol3)).ClearContents
    
    myST(1).Range(Cells(1, 1).Address, Cells(1, LastCol1).Address).Copy
    Cells(1, 1).PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
    Cells(1, LastCol1 + 1).Value = "Machine"

    Application.Calculation = xlCalculationManual
    
    cr = 2
    For i1 = 2 To LastRow1
        Application.StatusBar = "Processing row " & i1 & " de " & LastRow1
        myST(2).Range(Cells(i1, LastCol2 + 1).Address, Cells(i1, myLastM).Address).Copy
        Cells(cr, LastCol1 + 1).PasteSpecial Paste:=xlPasteValues, Transpose:=True
        Application.CutCopyMode = False
        myCountM = myST(2).Cells(i1, myLastM + 1).Value
        myCountM = IIf(myCountM = 0, 1, myCountM)
        
        myST(1).Range(Cells(i1, 1).Address, Cells(i1, LastCol1).Address).Copy Destination:=Range(Cells(cr, 1), Cells(cr + myCountM - 1, LastCol1))
        cr = cr + myCountM
    Next i1
    Range(Cells(1, 1), Cells(1, LastCol1 + 1)).EntireColumn.AutoFit
    
    Sheets("Combine Build List").Unprotect ("Combine")
    myST(2).Range(Cells(1, LastCol2 + 1).Address, Cells(1, myLastM + 1).Address).EntireColumn.Delete
    'Sheets("Combine Build List").Protect ("Combine")
    
    For i1 = 1 To 3
        Set myST(i1) = Nothing
    Next i1
    
    Application.StatusBar = False
    Application.Calculation = xlCalculationAutomatic
    
    Sheets("Data Storage").Select
    ActiveWindow.SelectedSheets.Visible = False
    
    Sheets("Weight Summary").Select
    
    ActiveSheet.Unprotect ("Combine")
    ActiveSheet.PivotTables("Weight_Summary").PivotCache.Refresh
    ActiveSheet.Protect ("Combine")
    
    Application.ScreenUpdating = True

End Sub
 

Excel Facts

Enter current date or time
Ctrl+: enters current time. Ctrl+; enters current date. Use Ctrl+: Ctrl+; Enter for current date & time.
When you do an inline copy (copy and paste in the same line of code), the copy is all-inclusive.

To do a values only paste you would need to give a separate paste command.

For example, this one line of code:
Code:
Cells(2, LastCol2 + 1).Copy Destination:=Range(Cells(2, LastCol2 + 2), Cells(2, myLastM))

...would change to these two lines of code:
Code:
Cells(2, LastCol2 + 1).Copy 
Range(Cells(2, LastCol2 + 2), Cells(2, myLastM)).PasteSpecial xlPasteValues


Now take that approach and make the changes to your macro in the spots where you want values pasted instead of everything.
 
Upvote 0
Just for giggles, there is another way to transfer values only with a single command, but it's not a true copy/paste. It's reversed:

Code:
Range(Cells(2, LastCol2 + 2), Cells(2, myLastM)).Value = Cells(2, LastCol2 + 1).Value
 
Upvote 0

Forum statistics

Threads
1,224,600
Messages
6,179,836
Members
452,947
Latest member
Gerry_F

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top