Home Menu

Menu


ExcelBanter » Excel Newsgroups » Excel Programming > Whats wrong with this code
Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 54
Default Whats wrong with this code
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


Reply With QuoteReply With Quote
  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 391
Default Whats wrong with this code
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


-----Original Message-----
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


.

Reply With QuoteReply With Quote
  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 391
Default Whats wrong with this code
sorry...tab sent off the mail :(

Sub Checker()
Dim cell as range
For Each cell In Range("D9:D98")
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



-----Original Message-----
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


.

Reply With QuoteReply With Quote
  #4   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 54
Default Whats wrong with this code
I apologise for any confusion.

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

Thank you!!
"Patrick Molloy" wrote in message
...
sorry...tab sent off the mail :(

Sub Checker()
Dim cell as range
For Each cell In Range("D9:D98")
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



-----Original Message-----
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


.



Reply With QuoteReply With Quote
  #5   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 54
Default Whats wrong with this code
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!!

"Patrick Molloy" wrote in message
...
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


-----Original Message-----
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


.



Reply With QuoteReply With Quote
  #6   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 14
Default Whats wrong with this code
Hi patrick

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

Thank you!!!!
Reply With QuoteReply With Quote
Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes
Linear Mode Linear Mode

Posting Rules
Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On

Similar Threads
Thread Thread Starter Forum Replies Last Post
whats wrong with this? brownti via OfficeKB.com Excel Discussion (Misc queries) 10 February 12th 07 02:39 PM
Whats wrong with this OR formula? Mark Excel Worksheet Functions 4 October 23rd 06 07:16 PM
whats wrong with the formula? Gary Excel Worksheet Functions 2 August 3rd 06 11:33 AM
Whats wrong with this? LucasBuck Excel Discussion (Misc queries) 3 January 12th 06 08:15 PM
Whats Wrong with this?? drvortex Excel Worksheet Functions 1 October 30th 04 06:48 PM


All times are GMT +1. The time now is 05:48 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"

 

Contact Us ExcelBanter forum home Privacy Statement