Run-time error 1004 Application-defined or object defined error

Question

I have looked through the other posts about this and have tried adapted the strategies that were recommend by using Set ActiveWorkbook and Set Active Worksheet and I still get the same error. I hope another set of eyes can help out as I am still very new to VBA and I am not all that comfortable with it yet.

Basically the idea is to copy the cells from column f to column j as values as long as the cells of F do not match the cells of J. I get the row count of column E and use that as my count in the for loop.

Code is here:

Private Sub CalculateRewards_Click()
    CopyPaste
End Sub

Sub CopyPaste()
    Dim n As Integer
    Dim i As Integer


     n = Sheets("Calculate").Range("E:E").Cells.SpecialCells(xlCellTypeConstants).Count
     i = n

     For Counter = 1 To n

         Set curCell = Sheets("Calculate").Range("F2:F" &i)
         If "$F" &i <> "$J" &i Then
             Sheets("Calculate").Range("$F:$F" &i).Copy
             Sheets("Calculate").Range("$J:$J" &i).PasteSpecial (xlPasteValues)
             Application.CutCopyMode = False
          End If

          i = i + 1
      Next Counter

End Sub

Thanks for the help

Also Edit: Link to Excel Sheet that has a before page, after first transaction sheet ,and a after second transaction sheet: https://www.dropbox.com/s/n2mn0zyrtoscjin/Rewards.xlsm

Answer 1

CHange this:

     Set curCell = Sheets("Calculate").Range("F2:F" &i)
     If "$F" &i <> "$J" &i Then
         Sheets("Calculate").Range("$F:$F" &i).Copy
         Sheets("Calculate").Range("$J:$J" &i).PasteSpecial (xlPasteValues)
         Application.CutCopyMode = False
      End If

To this:

     Set curCell = Sheets("Calculate").Range("F2:F" & i)
      If curCell <> Sheets("Calculate").Range("$J" & i) Then
         Sheets("Calculate").Range("$J:$J" &i).Value = curCell.Value
      End If

May need to do some more teaking as I notice you're working with SpecialCells which essentially filters the range, so iterating For i = 1 to n... probably does not work. Maybe something like:

    Dim rngCalc as Range
    Set rngCalc = Sheets("Calculate").Range("E:E").Cells.SpecialCells(xlCellTypeConstants)
    For each curCell in rngCalc.Cells
        If curCell <> curCell.Offset(0, 4) Then
            curCell.Offset(0, 4).Value = curCell.Value
        End If
    Next

Answer 2

EDIT: this sub will calculate the points for the last transaction (identified as the furthest-right column containing transactions) and write them down in column C.

Option Explicit
Sub UpdateCurrentPurchase()

Dim CalcSheet As Worksheet
Dim LastTransRange As Range, TargetRange As Range
Dim LastTransCol As Long, LastTransRow As Long
Dim PurchaseArray() As Variant
Dim Points As Long, Index As Long

'set references up-front
Set CalcSheet = ThisWorkbook.Worksheets("Calculate")
With CalcSheet
    LastTransCol = .Cells(2, .Columns.Count).End(xlToLeft).Column '<~ find the last column
    LastTransRow = .Cells(.Rows.Count, LastTransCol).End(xlUp).Row
    Set LastTransRange = .Range(.Cells(2, LastTransCol), .Cells(LastTransRow, LastTransCol))
    Set TargetRange = .Range(.Cells(2, 6), .Cells(LastTransRow, 6)) '<~ column F is the Current Purchase Col
    LastTransRange.Copy Destination:=TargetRange '<~ copy last transactions to Current Purchase Col
End With

'pull purchases into a variant array
PurchaseArray = TargetRange

'calculate points
For Index = 1 To LastTransRow
    Points = Int(PurchaseArray(Index, 1) / 10) '<~ calculate points
    CalcSheet.Cells(Index + 1, 3) = Points '<~ write out the points amount in col C
Next Index

End Sub

ORIGINAL RESPONSE: I think the below will get you where you're going. That being said, it seems like simply overwriting column J with column F (as values) might be the fastest way to an acceptable answer, so if that's the case we can re-work this code to be much quicker using Range objects.

Option Explicit
Private Sub CalculateRewards_Click()
    CopyPaste
End Sub

Sub CopyPaste()

Dim LastRow As Long, Counter As Long
Dim cSheet As Worksheet '<~ add a worksheet reference to save some typing

'set references up front
Set cSheet = ThisWorkbook.Worksheets("Calculate")
With cSheet
    LastRow = .Range("E" & .Rows.Count).End(xlUp).Row '<~ set loop boundary

    'loop that compares the value in column 6 (F) to the value in
    'column 10 (J) and writes the value from F to J if they are not equal
    For Counter = 1 To LastRow
        If .Cells(Counter, 6).Value <> .Cells(Counter, 10).Value Then
            .Cells(Counter, 10) = .Cells(Counter, 6)
        End If
    Next Counter
End With

End Sub