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)
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!
Nice to hear from you again.
Is this it?
https://wetransfer.com/downloads/24b0c3336358f1d67ee7157cab64cbfb20210105021917/7d37c7
I had it in my personal file.
The old Drop Box file has been deleted. Free file sharing sites generally only allow one month "free" then delete them.
Let me know if you need any help.
Cheerio,
vcoolio.
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?
Thank you!