Hi again,

With the following code, command button 3 and 4 are supposed to perform the
same function except that if corresponding cell (column C) is red, data
pastes to a different cell (column G instead of F) I cant get this to work,
it always pastes data to column G either way. I am in desperate need of
help!!!!!!!!

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 0 Then
Cells(cell.Row, 1).Copy
Sh.Cells(rw, "A").PasteSpecial Paste:=xlPasteValues
Cells(cell.Row, 4).Copy
Sh.Cells(rw, "F").PasteSpecial Paste:=xlPasteValues
rw = rw + 1
End If
End If
End If
Next
End Sub

Private Sub CommandButton4_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(rw, "C").Interior.ColorIndex = 3 And cell(rw, "D").Value 1
Then
ElseIf 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

Private Sub Worksheet_BeforeDoubleClick _
(ByVal Target As Range, Cancel As Boolean)
Cancel = True
If Not Intersect(Target, Range("C1:C128")) _
Is Nothing Then 'use your desired range
With Target.Interior
If .ColorIndex = 3 Then
.ColorIndex = xlColorIndexNone
Else
.ColorIndex = 3
End If
End With
End If
End Sub