Copy and Paste entire row if a specific cell agrees with if cond

[Closed]
Report
Posts
11
Registration date
Monday July 17, 2017
Status
Member
Last seen
August 12, 2017
-
Posts
11
Registration date
Monday July 17, 2017
Status
Member
Last seen
August 12, 2017
-
Hello guys!

I have been writing a vba code for a while and I cant find the mistake that I am making... I have a big table and I am comparing the values between column U and V column U and W column AB with AC and finally AB with AD. So I am making 4 comparisons for each row. If the difference between any of these comparisons is bigger than a specific value I want to copy and paste the entire row to another sheet.. So, even if one comparison out of the 4 that exist in a row is not good (the difference is bigger), I want the whole row to pasted to the other sheet. .. can you please help??

Sub macro()

Dim mDiff1 As Double
mDiff1 = 0.01

Dim mDiff2 As Double
mDiff2 = 0.03

Dim mDiff3 As Double
mDiff3 = 0.01

Dim mDiff4 As Double
mDiff4 = 0.03

Sheets("TRACKER").Select

For Each cell1 In Range("U2:U" & Range("U" & Rows.Count).End(xlUp).Row)
If cell1.Value - cell1.Offset(0, 1).Value > mDiff1 Then
cell1.Offset(0, 1).Interior.ColorIndex = 3
End If
If cell1.Value - cell1.Offset(0, 2).Value > mDiff2 Then
cell1.Offset(0, 2).Interior.ColorIndex = 5
End If
If cell1.Value - cell1.Offset(0, 1).Value > mDiff1 Or cell1.Value - cell1.Offset(0, 2).Value > mDiff2 Then
cell1.EntireRow.Copy
Sheets("WFR+VFR report").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues

End If

Next cell1


For Each cell2 In Range("AB2:AB" & Range("AB" & Rows.Count).End(xlUp).Row)
If cell2.Value - cell2.Offset(0, 1).Value > mDiff3 Then
cell2.Offset(0, 1).Interior.ColorIndex = 3
End If
If cell2.Value - cell2.Offset(0, 2).Value > mDiff4 Then
cell2.Offset(0, 2).Interior.ColorIndex = 5
End If
If cell2.Value - cell2.Offset(0, 1).Value > mDiff3 Or cell2.Value - cell2.Offset(0, 2).Value > mDiff4 Then
cell2.EntireRow.Copy
Sheets("WFR+VFR report").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues

End If

Next cell2

End Sub

3 replies


The only way that this code will run, is by being called from a MACRO. Functions running USER DEFINED FUNCTIONS, cannot manipulate sheet data from a function (easily). It has to be performed by a macro. SO, if everything works but the copy and paste, it is because it is being calle dby a UDF, and not a macro. A simple work around, is attach a button, and run the same code from the button.
Posts
11
Registration date
Monday July 17, 2017
Status
Member
Last seen
August 12, 2017

First of all thank you very much for your answer! However, I didn't quite understand it :( I am running the above macro with a button (ctrl+a) and it is a macro.. So, what should I change to make it work? Do you see any glaring mistake? (also, I just want to copy and paste the values of the rows without the formulas).
Well, I didn't see where Cell1 and cell2 were initialized as cells, or ranges, so I am not certain you are constructing the object correctly.

You might need to (edit)DECLARE
<del>initialize</del>
cell1 and cell2 as ranges, as in:

dim cell1 as RANGE

It's kind of fun to do the impossible! -Walter Elias Disney
Posts
11
Registration date
Monday July 17, 2017
Status
Member
Last seen
August 12, 2017
> Blocked Profile
Thanks again :) I tried everything.. nothing will work :( ouff ...This is my last format of code.. any last recommendations ?? Thank you very much for you time !

Sub WFRVFR_performance()

Dim mDiff1 As Double
mDiff1 = 0.01

Dim mDiff2 As Double
mDiff2 = 0.03

Dim mDiff3 As Double
mDiff3 = 0.01

Dim mDiff4 As Double
mDiff4 = 0.03

Dim cell1 As Range

Dim cell2 As Range

Sheets("TRACKER").Select

For Each cell1 In Range("U2:U" & Range("U" & Rows.Count).End(xlUp).Row)
If cell1.Value - cell1.Offset(0, 1).Value > mDiff1 Then
cell1.Offset(0, 1).Interior.ColorIndex = 3
End If
If cell1.Value - cell1.Offset(0, 2).Value > mDiff2 Then
cell1.Offset(0, 2).Interior.ColorIndex = 5
End If
If cell1.Value - cell1.Offset(0, 1).Value > mDiff1 Or cell1.Value - cell1.Offset(0, 2).Value > mDiff2 Then GoSub CopyPastecell1
Exit Sub
CopyPastecell1:
cell1.EntireRow.Copy
Sheets("WFR+VFR report").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
Return


Next cell1


For Each cell2 In Range("AB2:AB" & Range("AB" & Rows.Count).End(xlUp).Row)
If cell2.Value - cell2.Offset(0, 1).Value > mDiff3 Then
cell2.Offset(0, 1).Interior.ColorIndex = 3
End If
If cell2.Value - cell2.Offset(0, 2).Value > mDiff4 Then
cell2.Offset(0, 2).Interior.ColorIndex = 5
End If
If cell2.Value - cell2.Offset(0, 1).Value > mDiff3 Or cell2.Value - cell2.Offset(0, 2).Value > mDiff4 Then GoSub CopyPastecell2
Exit Sub
CopyPastecell2:
cell2.EntireRow.Copy
Sheets("WFR+VFR report").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
Return

Next cell2

End Sub
Blocked Profile
YOu are only going to GOSUB if this condition is met:

If cell1.Value - cell1.Offset(0, 1).Value > mDiff1 Or cell1.Value - cell1.Offset(0, 2).Value > mDiff2 Then GoSub CopyPastecell1

Is that what you intnded?
Posts
11
Registration date
Monday July 17, 2017
Status
Member
Last seen
August 12, 2017

yes exactly! but still is not working ...
Blocked Profile
Ok, do the math in a separate line, as in:
Val1=cell1.Value
Val2=cell1.Offset(0, 1).Value
Val3=Val1-Val2

Val4=cell1.Value
Val5=cell1.Offset(0, 2).Value
Val6= Val4-Val5

If Val3 > mDiff1 Or
Val6 > mDiff2 Then GoSub CopyPastecell1

Try that and see if that changes the result.
Unfortunately it didn't work :( thanks for your time man :)

Sorry so slow in response...it is a terribly busy time for me, and I haven't been able to check back.

Post your entire code, so we can look at how it is flowing!
Posts
11
Registration date
Monday July 17, 2017
Status
Member
Last seen
August 12, 2017

ac3mark thank you very much for everything! you are doing me a huge favor so please dont even mention it :)

Sub WFRVFR_performance()

Application.Calculation = xlCalculationManual

Application.ScreenUpdating = False

Dim mDiff1 As Double
mDiff1 = 0.01

Dim mDiff2 As Double
mDiff2 = 0.03

Dim mDiff3 As Double
mDiff3 = 0.01

Dim mDiff4 As Double
mDiff4 = 0.03

Dim cell1 As Range

Dim cell2 As Range

Sheets("TRACKER").Select

For Each cell1 In Range("U2:U" & Range("U" & Rows.Count).End(xlUp).Row)
If cell1.Value - cell1.Offset(0, 1).Value > mDiff1 Then
cell1.Offset(0, 1).Interior.ColorIndex = 3
End If
If cell1.Value - cell1.Offset(0, 2).Value > mDiff2 Then
cell1.Offset(0, 2).Interior.ColorIndex = 5
End If
If cell1.Value - cell1.Offset(0, 1).Value > mDiff1 Or cell1.Value - cell1.Offset(0, 2).Value > mDiff2 Then GoSub CopyPastecell1
Exit Sub
CopyPastecell1:
cell1.EntireRow.Copy
Sheets("WFR+VFR report").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
Return

Next cell1

For Each cell2 In Range("AB2:AB" & Range("AB" & Rows.Count).End(xlUp).Row)
If cell2.Value - cell2.Offset(0, 1).Value > mDiff3 Then
cell2.Offset(0, 1).Interior.ColorIndex = 3
End If
If cell2.Value - cell2.Offset(0, 2).Value > mDiff4 Then
cell2.Offset(0, 2).Interior.ColorIndex = 5
End If
If cell2.Value - cell2.Offset(0, 1).Value > mDiff3 Or cell2.Value - cell2.Offset(0, 2).Value > mDiff4 Then GoSub CopyPastecell2
Exit Sub
CopyPastecell2:
cell2.EntireRow.Copy
Sheets("WFR+VFR report").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
Return

Next cell2

Sheets("WFR+VFR report").Select

Columns(4).RemoveDuplicates Columns:=Array(1)
On Error Resume Next
Columns(4).SpecialCells(xlBlanks).EntireRow.Delete

For Each cell1 In Range("U2:U" & Range("U" & Rows.Count).End(xlUp).Row)
If cell1.Value - cell1.Offset(0, 1).Value > mDiff1 Then
cell1.Offset(0, 1).Interior.ColorIndex = 3
End If
If cell1.Value - cell1.Offset(0, 2).Value > mDiff2 Then
cell1.Offset(0, 2).Interior.ColorIndex = 5
End If

Next cell1

For Each cell2 In Range("AB2:AB" & Range("AB" & Rows.Count).End(xlUp).Row)
If cell2.Value - cell2.Offset(0, 1).Value > mDiff3 Then
cell2.Offset(0, 1).Interior.ColorIndex = 3
End If
If cell2.Value - cell2.Offset(0, 2).Value > mDiff4 Then
cell2.Offset(0, 2).Interior.ColorIndex = 5
End If

Next cell2

Sheets("TRACKER").Select

Sheets("TRACKER").Range("A1:AU1").Copy Sheets("WFR+VFR report").Range("A1:AU1")

Sheets("WFR+VFR report").Select
If Not ActiveSheet.AutoFilterMode Then
ActiveSheet.Rows(1).AutoFilter
End If

Application.Calculation = xlCalculationAutomatic

Application.ScreenUpdating = True

End Sub