Whats wrong with this code

[gav meredith]

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("D913"), "FEEDER"
CopyData Range("D1658"), "MACHINE"
CopyData Range("D6373"), "DELIVERY"
CopyData Range("D7882"), "PECOM"
CopyData Range("D8894"), "ROLLERS"
CopyData Range("D104128"), "MISCELLANEOUS"
Dim rng As Range, cell As Range
Dim nrow As Long, rw As Long
Dim Sh As Worksheet
Set rng = Range("D994")
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("D998")
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("D913"), "FEEDER"
CopyData Range("D1658"), "MACHINE"
CopyData Range("D6373"), "DELIVERY"
CopyData Range("D7882"), "PECOM"
CopyData Range("D8894"), "ROLLERS"
CopyData Range("D104128"), "MISCELLANEOUS"
Dim rng As Range, cell As Range
Dim nrow As Long, rw As Long
Dim Sh As Worksheet
Set rng = Range("D994")
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("D998")
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

 

[Patrick Molloy]

try keeping your post within the same thread please. In
your original, you stated that If the value in D was > 1
as well as the cell being red...however I'm not clear on
your loop. when checking D9 your code looks at the color
in C10 .

Sub Test()
dim cell as range

End Sub

 

[Patrick Molloy]

sorry...tab sent off the mail

Sub Checker()
Dim cell as range
For Each cell In Range("D998")
If Not IsEmpty(cell) Then
If IsNumeric(cell.Value) Then
If cell(cell.row, "C").Interior.ColorIndex = 3 _
And _
cell.Value > 1 Then
cells(cell.Row,"G").Value = Cell.Value
End If
End If
End If
Nexr

End Sub

 

[gav meredith]

I apologise for any confusion.

Do i simply insert this with my existing code?? Where should i insert it??

Thank you!!

 

[gav meredith]

Yes. With the current code, if column D is greater than 1, copy/paste occurs
to VKnew. What i would like is, with the same criterea except that if
corresponding cell in column C is red then the data is to paste to a
different column on VKnew. It is for a user to select options by
highlighting a cell red, indicating it as an option.

Thank you!!

 

[gav meredith]

Hi patrick

im still having trouble with this. how do i implement it?? Sorry, am a novice at this!

Thank you!!!!