Need code edit..

VBABEGINER

Well-known Member
Joined
Jun 15, 2011
Messages
1,284
Office Version
  1. 365
Platform
  1. Windows
What went wrong this code..?
Code:
For k = 2 To UsdRws 'UsdRws To 2 Step -1


If Cells(k, 1).Interior.Color = vbYellow Then
Rows(k).Copy Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1)
Rows(k).Delete
End If
Next k
 

Excel Facts

Excel Joke
Why can't spreadsheets drive cars? They crash too often!
If you step -1 you need to work upwards so

Code:
For k  = UsdRws to 2 Step -1
 
Upvote 0
No, its not working. I want wherever, cell color is Yellow then cut and paste it into Sheet2. I think, it macro dont recognize the cell color.

If you step -1 you need to work upwards so

Code:
For k  = UsdRws to 2 Step -1
 
Upvote 0
So its working. Its just not doing what you require. Im afraid yellow is meaningless to excel unless its the special vbYellow but that's only one shade of yellow. You need to use a shade that it recognises all the time or the logical test is going to fail as you have seen. If you do something like this it will work. Firstly run this:

Code:
Range("A1").Interior.Color = vbYellow

Click into cell A1. Go to home tab and double click format painter. Click into all of your yellow cells one by one. You can then rerun your macro. By the way how are you going to prevent duplication? Each time you run this you will get duplication if the cells are still yellow.
 
Upvote 0
Apologies..
but not working my side.
Code:
Application.ScreenUpdating = False
UsdRws = Range("A" & Rows.Count).End(xlUp).Row
For k = UsdRws To 2 Step -1

If Cells(k, 1).Interior.Color = 65535 Then
Rows(k).Copy Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1)
Rows(k).Delete
End If
Next k
Application.ScreenUpdating = True
 
Last edited:
Upvote 0
That works assuming you are on the correct sheet when you invoke the macro and your interior color of the cell is indeed vbYellow.
 
Upvote 0
The code will run correctly provided the conditions in post 6 are adhered to. That bit has nothing to do with code.
 
Upvote 0
With Conditional formatting...actually its long process Phil..

Requirement now is like, wherever the cell color is Yellow, that gets cut and paste it into Sheet2.
I am taking in sheet2 b'coz im not that much hard coder...

After taking on sheet2, im using this code..Actually my original code is this..
Code:
'copy in new workbook
Range("A2", Range("F500").End(xlDown)).Copy
Dim wb As Workbook
Set wb = Workbooks.Add
ActiveSheet.Paste
Application.CutCopyMode = False
Range("A2").Select


Columns("C:D").Select
Selection.EntireColumn.Delete




Dim UsdRws As Long, k As Long
Application.ScreenUpdating = False
UsdRws = Range("A" & Rows.Count).End(xlUp).Row
For k = UsdRws To 2 Step -1


'If Cells(k, 1).Interior.Color = 65535 Then
'Rows(k).Copy Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1)
'Rows(k).Delete
'End If
'Next k


If Range("A" & k).Value Like "Exclusions" Then
    Rows(k).Copy Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1)
    Rows(k).Delete
ElseIf Range("A" & k).Value Like "* Exclusions" Then
    Rows(k).Copy Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1)
    Rows(k).Delete
ElseIf Range("A" & k).Value Like "Exclusions *" Then
    Rows(k).Copy Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1)
    Rows(k).Delete
ElseIf Range("A" & k).Value Like "* Exclusions *" Then
    Rows(k).Copy Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1)
    Rows(k).Delete




ElseIf Range("A" & k).Value Like "Exclusion" Then
    Rows(k).Copy Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1)
    Rows(k).Delete
ElseIf Range("A" & k).Value Like "* Exclusion" Then
    Rows(k).Copy Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1)
    Rows(k).Delete
ElseIf Range("A" & k).Value Like "Exclusion *" Then
    Rows(k).Copy Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1)
    Rows(k).Delete
ElseIf Range("A" & k).Value Like "* Exclusion *" Then
    Rows(k).Copy Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1)
    Rows(k).Delete
ElseIf Range("A" & k).Value Like "Exclusion * " Then
    Rows(k).Copy Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1)
    Rows(k).Delete
ElseIf Range("A" & k).Value Like "Exclusion-*" Then
    Rows(k).Copy Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1)
    Rows(k).Delete
    


ElseIf Range("A" & k).Value Like "Excl" Then
    Rows(k).Copy Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1)
    Rows(k).Delete
ElseIf Range("A" & k).Value Like "* Excl" Then
    Rows(k).Copy Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1)
    Rows(k).Delete
ElseIf Range("A" & k).Value Like "Excl *" Then
    Rows(k).Copy Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1)
    Rows(k).Delete
ElseIf Range("A" & k).Value Like "* Excl *" Then
    Rows(k).Copy Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1)
    Rows(k).Delete
ElseIf Range("A" & k).Value Like "Excl-* " Then
    Rows(k).Copy Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1)
    Rows(k).Delete
ElseIf Range("A" & k).Value Like "Excl-*" Then
    Rows(k).Copy Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1)
    Rows(k).Delete
End If


Next k
Application.ScreenUpdating = True


Range("A1:D1").Copy
Range("G1").Select
ActiveSheet.Paste
Sheets("Sheet2").Select
ActiveSheet.UsedRange.Select
Selection.Copy
Sheets("sheet1").Select
Range("G2").Select
ActiveSheet.Paste
Sheets("Sheet2").Select
ActiveSheet.UsedRange.Clear
Cells(1, 1).Select
Sheets("Sheet1").Select
ActiveWindow.Zoom = 90
Columns("E:F").Select
Selection.ColumnWidth = 4

but the requirement increasing day by day for "Excl" and "Exclusion" word...therefore, instead of mentioning this manual type I decide to use, conditional formatting wherever I find "Excl" and "Exclusion", make it Yellow color.

Now, I'm trying to get Yellow on Sheet1, Start from G2..

I think, my code is suffiecient to understand what I'm trying to do..

Thanks..Help appreciated pls..


how are you coloring the cell, are you using Conditional Formatting (CF) or using cell fill?
 
Upvote 0

Forum statistics

Threads
1,223,903
Messages
6,175,284
Members
452,630
Latest member
OdubiYouth

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