ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Differentiate between cell colours (https://www.excelbanter.com/excel-programming/296513-differentiate-between-cell-colours.html)

gav meredith
Differentiate between cell colours
 
Hello,

can someone please alter this code so that if a cell in column D is NOT red, then data pastes to column F instead of column G. Currently, rows with a red cell in column D paste to column A and G on sheet VKnew. I want the rows without a red cell in column D to paste to column F (not G) on VKnew.


Private Sub CommandButton3_Click()
CopyData Range("D9:D13"), "FEEDER"
CopyData Range("D16:D58"), "MACHINE"
CopyData Range("D63:D73"), "DELIVERY"
CopyData Range("D78:D82"), "PECOM"
CopyData Range("D88:D94"), "ROLLERS"
CopyData Range("D104:D128"), "MISCELLANEOUS"
Dim rng As Range, cell As Range
Dim nrow As Long, rw As Long
Dim Sh As Worksheet
Set rng = Range("D9:D94")
nrow = Application.CountIf(rng, "0")
Set Sh = Worksheets("VK new")
Debug.Print Sh.Range("A10").Resize(nrow * 1, 1).EntireRow.Address(external:=True)
' sh.Range("A10").Resize(nrow * 1).EntireRow.Insert
rw = 10
For Each cell In Range("D9:D98")
If Not IsEmpty(cell) Then
If IsNumeric(cell) Then
If cell.Interior.ColorIndex = 3 And cell.Value 0 Then
'If cell 0 Then
Cells(cell.Row, 1).Copy
Sh.Cells(rw, "A").PasteSpecial Paste:=xlPasteValues
Cells(cell.Row, 4).Copy
Sh.Cells(rw, "G").PasteSpecial Paste:=xlPasteValues
rw = rw + 1
End If
End If
End If
Next
End Sub


Thank you!!!!!!

Cecilkumara Fernando[_2_]
Differentiate between cell colours
 
gav meredith,
This is the answer I gave you for a earlier post only changed red cell checking from C to D
Hope this is what you want

Private Sub CommandButton3_Click()
'what is this copydata it is not working for me
'copydata Range("D9:D13"), "FEEDER"
'copydata Range("D16:D58"), "MACHINE"
'copydata Range("D63:D73"), "DELIVERY"
'copydata Range("D78:D82"), "PECOM"
'copydata Range("D88:D94"), "ROLLERS"
'copydata Range("D104:D128"), "MISCELLANEOUS"
Dim rng As Range, cell As Range
Dim nrow As Long, rw As Long
Dim col As String
Dim Sh As Worksheet
Set rng = Range("D9:D94")
nrow = Application.CountIf(rng, "0")
Set Sh = Worksheets("VK new")
'Debug.Print Sh.Range("A10").Resize(nrow * 1, 1).EntireRow _
..Address(external:=True)
' **to insert lines to accommodate new data _
activate the line below by removing " ' "**
'Sh.Range("A10").Resize(nrow * 1).EntireRow.Insert
' ** the line below will clear earlier data **
'Sh.Range("A10:G99").ClearContents
rw = 10
For Each cell In Range("D9:D98")
If Cells(cell.row, "D").Interior.ColorIndex = 3 Then
col = "G"
Else
col = "F"
End If
If Not IsEmpty(cell) Then
If IsNumeric(cell) Then
If cell 0 Then
Cells(cell.row, 1).Copy
Sh.Cells(rw, "A").PasteSpecial Paste:=xlPasteValues
Cells(cell.row, 4).Copy
Sh.Cells(rw, col).PasteSpecial Paste:=xlPasteValues
' **above four lines can be replaced with these lines**
'Cells(cell.row, 1).Copy Sh.Cells(rw, "A")
'Cells(cell.row, 4).Copy Sh.Cells(rw, col)
' **If you don't have formulas in Column A & D**
rw = rw + 1
End If
End If
End If
Next
End Sub

HTH
Cecil

"gav meredith" wrote in message ...
Hello,

can someone please alter this code so that if a cell in column D is NOT red, then data pastes to column F instead of column G. Currently, rows with a red cell in column D paste to column A and G on sheet VKnew. I want the rows without a red cell in column D to paste to column F (not G) on VKnew.


Private Sub CommandButton3_Click()
CopyData Range("D9:D13"), "FEEDER"
CopyData Range("D16:D58"), "MACHINE"
CopyData Range("D63:D73"), "DELIVERY"
CopyData Range("D78:D82"), "PECOM"
CopyData Range("D88:D94"), "ROLLERS"
CopyData Range("D104:D128"), "MISCELLANEOUS"
Dim rng As Range, cell As Range
Dim nrow As Long, rw As Long
Dim Sh As Worksheet
Set rng = Range("D9:D94")
nrow = Application.CountIf(rng, "0")
Set Sh = Worksheets("VK new")
Debug.Print Sh.Range("A10").Resize(nrow * 1, 1).EntireRow.Address(external:=True)
' sh.Range("A10").Resize(nrow * 1).EntireRow.Insert
rw = 10
For Each cell In Range("D9:D98")
If Not IsEmpty(cell) Then
If IsNumeric(cell) Then
If cell.Interior.ColorIndex = 3 And cell.Value 0 Then
'If cell 0 Then
Cells(cell.Row, 1).Copy
Sh.Cells(rw, "A").PasteSpecial Paste:=xlPasteValues
Cells(cell.Row, 4).Copy
Sh.Cells(rw, "G").PasteSpecial Paste:=xlPasteValues
rw = rw + 1
End If
End If
End If
Next
End Sub


Thank you!!!!!!

gav meredith
Differentiate between cell colours
 
that is exactly what i was after. I cant thank you enough!!!!!


"Cecilkumara Fernando" <cekufdo@sltnetDOTlk wrote in message ...
gav meredith,
This is the answer I gave you for a earlier post only changed red cell checking from C to D
Hope this is what you want

Private Sub CommandButton3_Click()
'what is this copydata it is not working for me
'copydata Range("D9:D13"), "FEEDER"
'copydata Range("D16:D58"), "MACHINE"
'copydata Range("D63:D73"), "DELIVERY"
'copydata Range("D78:D82"), "PECOM"
'copydata Range("D88:D94"), "ROLLERS"
'copydata Range("D104:D128"), "MISCELLANEOUS"
Dim rng As Range, cell As Range
Dim nrow As Long, rw As Long
Dim col As String
Dim Sh As Worksheet
Set rng = Range("D9:D94")
nrow = Application.CountIf(rng, "0")
Set Sh = Worksheets("VK new")
'Debug.Print Sh.Range("A10").Resize(nrow * 1, 1).EntireRow _
.Address(external:=True)
' **to insert lines to accommodate new data _
activate the line below by removing " ' "**
'Sh.Range("A10").Resize(nrow * 1).EntireRow.Insert
' ** the line below will clear earlier data **
'Sh.Range("A10:G99").ClearContents
rw = 10
For Each cell In Range("D9:D98")
If Cells(cell.row, "D").Interior.ColorIndex = 3 Then
col = "G"
Else
col = "F"
End If
If Not IsEmpty(cell) Then
If IsNumeric(cell) Then
If cell 0 Then
Cells(cell.row, 1).Copy
Sh.Cells(rw, "A").PasteSpecial Paste:=xlPasteValues
Cells(cell.row, 4).Copy
Sh.Cells(rw, col).PasteSpecial Paste:=xlPasteValues
' **above four lines can be replaced with these lines**
'Cells(cell.row, 1).Copy Sh.Cells(rw, "A")
'Cells(cell.row, 4).Copy Sh.Cells(rw, col)
' **If you don't have formulas in Column A & D**
rw = rw + 1
End If
End If
End If
Next
End Sub

HTH
Cecil

"gav meredith" wrote in message ...
Hello,

can someone please alter this code so that if a cell in column D is NOT red, then data pastes to column F instead of column G. Currently, rows with a red cell in column D paste to column A and G on sheet VKnew. I want the rows without a red cell in column D to paste to column F (not G) on VKnew.


Private Sub CommandButton3_Click()
CopyData Range("D9:D13"), "FEEDER"
CopyData Range("D16:D58"), "MACHINE"
CopyData Range("D63:D73"), "DELIVERY"
CopyData Range("D78:D82"), "PECOM"
CopyData Range("D88:D94"), "ROLLERS"
CopyData Range("D104:D128"), "MISCELLANEOUS"
Dim rng As Range, cell As Range
Dim nrow As Long, rw As Long
Dim Sh As Worksheet
Set rng = Range("D9:D94")
nrow = Application.CountIf(rng, "0")
Set Sh = Worksheets("VK new")
Debug.Print Sh.Range("A10").Resize(nrow * 1, 1).EntireRow.Address(external:=True)
' sh.Range("A10").Resize(nrow * 1).EntireRow.Insert
rw = 10
For Each cell In Range("D9:D98")
If Not IsEmpty(cell) Then
If IsNumeric(cell) Then
If cell.Interior.ColorIndex = 3 And cell.Value 0 Then
'If cell 0 Then
Cells(cell.Row, 1).Copy
Sh.Cells(rw, "A").PasteSpecial Paste:=xlPasteValues
Cells(cell.Row, 4).Copy
Sh.Cells(rw, "G").PasteSpecial Paste:=xlPasteValues
rw = rw + 1
End If
End If
End If
Next
End Sub


Thank you!!!!!!


All times are GMT +1. The time now is 04:09 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com