Option Compare Text Sub TransferData() Dim lr As Long Dim i As Integer lr = Sheet1.Range("A" & Rows.Count).End(xlUp).Row Application.ScreenUpdating = False For i = 2 To lr If Cells(i, 6).Value <> "SPEC" And Cells(i, 6).Value <> "SALES CENTER" And Cells(i, 7).Value = 45 Then Range(Cells(i, 2), Cells(i, 28)).Copy Sheet2.Range("A" & Rows.Count).End(3)(2) ElseIf Cells(i, 6).Value <> "SPEC" And Cells(i, 6).Value <> "SALES CENTER" And Cells(i, 7).Value = 70 Then Range(Cells(i, 2), Cells(i, 28)).Copy Sheet3.Range("A" & Rows.Count).End(3)(2) ElseIf Cells(i, 6).Value <> "SPEC" And Cells(i, 6).Value <> "SALES CENTER" And Cells(i, 7).Value >= 90 Then Range(Cells(i, 1), Cells(i, 28)).Interior.ColorIndex = 4 End If If Cells(i, 16).Value = "" Or Cells(i, 16).Value = "N" Then Range(Cells(i, 1), Cells(i, 28)).Interior.ColorIndex = 6 End If Next i Application.CutCopyMode = False Application.ScreenUpdating = True End Sub
Also, if the column for keys has not been marked as received, I want the row to be highlighted yellow on the master sheet (sheet1)
A few words of thanks would be greatly appreciated. Add comment
5738 users have said thank you to us this month
If Cells(i, 6).Value <> "SPEC" And Cells(i, 6).Value <> "SALES CENTER" And Cells(i, 7).Value = 45 Then Range(Cells(i, 2), Cells(i, 28)).Copy Sheet2.Range("A" & Rows.Count).End(3)(2)
ElseIf Cells(i, 6).Value <> "SPEC" And Cells(i, 6).Value <> "SALES CENTER" And Cells(i, 7).Value = 70 Then Range(Cells(i, 2), Cells(i, 28)).Copy Sheet3.Range("A" & Rows.Count).End(3)(2)
ElseIf Cells(i, 6).Value <> "SPEC" And Cells(i, 6).Value <> "SALES CENTER" And Cells(i, 7).Value >= 90 Then Range(Cells(i, 1), Cells(i, 28)).Interior.ColorIndex = 4
Also, if the column for keys has not been marked as received, I want the row to be highlighted yellow on the master sheet (sheet1)
I have interpreted this to mean any cell in Column P that is blank or has an "N" placed in it.
If Cells(i, 16).Value = "N" Then
Option Compare Text Sub TransferData() Dim lr As Long Dim i As Integer lr = Sheet1.Range("A" & Rows.Count).End(xlUp).Row Application.ScreenUpdating = False For i = 2 To lr If Cells(i, 6).Value <> "SPEC" And Cells(i, 6).Value <> "SALES CENTER" And Cells(i, 7).Value = 45 Then Range(Cells(i, 2), Cells(i, 28)).Copy Sheet2.Range("A" & Rows.Count).End(3)(2) ElseIf Cells(i, 6).Value <> "SPEC" And Cells(i, 6).Value <> "SALES CENTER" And Cells(i, 7).Value = 70 Then Range(Cells(i, 2), Cells(i, 28)).Copy Sheet3.Range("A" & Rows.Count).End(3)(2) ElseIf Cells(i, 6).Value <> "SPEC" And Cells(i, 6).Value <> "SALES CENTER" And Cells(i, 7).Value >= 90 Then Range(Cells(i, 1), Cells(i, 28)).Interior.ColorIndex = 4 End If If Cells(i, 16).Value = "N" Then Range(Cells(i, 1), Cells(i, 28)).Interior.ColorIndex = 6 End If Next i Application.CutCopyMode = False Application.ScreenUpdating = True End Sub
If Cells(i, 16).Value = "" Or Cells(i, 16).Value = "N" And Cells(i, 7).Value >= 70 Then
Range(Cells(i, 1), Cells(i, 28)).Interior.ColorIndex = 6
End If
Option Compare Text Sub TransferData() Dim lr As Long Dim i As Integer lr = Sheet1.Range("A" & Rows.Count).End(xlUp).Row Application.ScreenUpdating = False For i = 2 To lr If Cells(i, 6).Value <> "SPEC" And Cells(i, 6).Value <> "SALES CENTER" And Cells(i, 7).Value = 45 Then Range(Cells(i, 2), Cells(i, 28)).Copy Sheet2.Range("A" & Rows.Count).End(3)(2) ElseIf Cells(i, 6).Value <> "SPEC" And Cells(i, 6).Value <> "SALES CENTER" And Cells(i, 7).Value = 70 Then Range(Cells(i, 2), Cells(i, 28)).Copy Sheet3.Range("A" & Rows.Count).End(3)(2) ElseIf Cells(i, 6).Value <> "SPEC" And Cells(i, 6).Value <> "SALES CENTER" And Cells(i, 7).Value >= 90 Then Range(Cells(i, 1), Cells(i, 28)).Interior.ColorIndex = 4 End If If Cells(i, 16).Value = "" Or Cells(i, 16).Value = "N" And Cells(i, 7).Value >= 70 Then Range(Cells(i, 1), Cells(i, 28)).Interior.ColorIndex = 6 End If Next i Application.CutCopyMode = False Application.ScreenUpdating = True End Sub
Range(Cells(i, 1), Cells(i, 28)).Copy Sheet2.Range("A" & Rows.Count).End(3)(2)
Range(Cells(i, 1), Cells(i, 28)).Copy Sheet3.Range("A" & Rows.Count).End(3)(2)
DON'T MISS
Thank you so so much! It works perfectly!! I truly appreciate it!
The "not equal to" SPEC or SALES CENTER code does not seem to be registering. Everything at 90% or 100% is turning green and ANYTHING without an answer in the keys field is turning yellow.
I only want those conditions to apply to homes that are SOLD (meaning the buyer column does NOT say "Spec" of "Sales Center". I am using Microsoft Excel 2007 - could this be the issue?