Report

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

Ask a question PeriGr 11Posts Monday July 17, 2017Registration date August 12, 2017 Last seen - Last answered on Aug 12, 2017 at 04:56 AM by PeriGr
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
Helpful
+0
plus moins
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.
PeriGr 11Posts Monday July 17, 2017Registration date August 12, 2017 Last seen - Aug 4, 2017 at 04:58 PM
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).
Reply
Leave a comment
Helpful
+0
plus moins
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

PeriGr 11Posts Monday July 17, 2017Registration date August 12, 2017 Last seen - Aug 5, 2017 at 11:19 AM
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
Reply
ac3mark 7998Posts Monday June 3, 2013Registration date ModeratorStatus October 17, 2017 Last seen - Aug 5, 2017 at 04:51 PM
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?
Reply
PeriGr 11Posts Monday July 17, 2017Registration date August 12, 2017 Last seen - Aug 5, 2017 at 05:41 PM
yes exactly! but still is not working ...
Reply
ac3mark 7998Posts Monday June 3, 2013Registration date ModeratorStatus October 17, 2017 Last seen - Aug 9, 2017 at 05:49 PM
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.
Reply
PeriGr- Aug 9, 2017 at 07:19 PM
Unfortunately it didn't work :( thanks for your time man :)
Reply
Leave a comment
Helpful
+0
plus moins
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!
PeriGr 11Posts Monday July 17, 2017Registration date August 12, 2017 Last seen - Aug 12, 2017 at 04:56 AM
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

Reply
Leave a comment

Member requests are more likely to be responded to.

Members can monitor the statuses of their requests from their account pages.

A CCM membership gives you access to additional options.

Not a member yet?

Sign up now. It takes less than a minute and is completely free!