Previous Topic Next Topic

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

Closed
PeriGr Posts 11 Registration date Monday July 17, 2017 Status Member Last seen August 12, 2017 - Aug 4, 2017 at 07:09 AM
PeriGr Posts 11 Registration date Monday July 17, 2017 Status Member Last seen August 12, 2017 - Aug 12, 2017 at 04:56 AM
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 responses

Answer 1 / 3
Blocked Profile
Aug 4, 2017 at 04:52 PM
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.
0
PeriGr Posts 11 Registration date Monday July 17, 2017 Status Member Last seen August 12, 2017
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).
0
Answer 2 / 3
Blocked Profile
Updated on Aug 4, 2017 at 06:54 PM
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
0
Blocked Profile
Aug 4, 2017 at 05:03 PM
Also, try ROWS(1).SELECT
0
PeriGr Posts 11 Registration date Monday July 17, 2017 Status Member Last seen August 12, 2017
Aug 4, 2017 at 05:15 PM
Ok so I run the macro and it doesn't crush.. However, when I am done, it only copy and pastes the last row.. Other than that, it works fine with no crushes.. But I want all the rows.. So, the problem must be in the copy and paste section of the macro, since the coloring in the main sheet is done correctly too! The only part not working is copying and pasting all cells.. also, ROWS(1).SELECT where should I add it in the code?
0
Blocked Profile
Aug 4, 2017 at 06:35 PM
Well, you can handle the copy each row in Three ways (way more but these are the obvious ones, unless I miss one, then whatever...):

...Load each value you wish to copy, into an array, and then retrieve the array later;
or...
...Place the copy command in between each time it changes the color format;
or...
you could GOSUB the copy command, then RETURN.

Disregard the rows method if this is working for you.

If you need help with the GOSUB and RETURN syntax, give this a look over:
https://docs.microsoft.com/en-us/office/vba/Language/Reference/User-Interface-Help/gosubreturn-statement
0
PeriGr Posts 11 Registration date Monday July 17, 2017 Status Member Last seen August 12, 2017 > Blocked Profile
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
0
Blocked Profile
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?
0
Answer 3 / 3
Blocked Profile
Aug 11, 2017 at 04:40 PM
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!
0
PeriGr Posts 11 Registration date Monday July 17, 2017 Status Member Last seen August 12, 2017
Updated on Aug 12, 2017 at 04:58 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

0

Similar discussions

Can no longer paste text into insta
6hypnone -
Richierichmeister -

6 responses
Highlight cell if another cell contains specific text
Abbi -
vcoolio -

1 response
If a cell contains any text then add a value
cbrizz -
Pharmanumbers -

20 responses
How to use conditional format based on text?
Leanne99 -
Mooseman -

26 responses
How can I make my name text invisible in Discord
imbenmark -
imbenmark -

4 responses