VBABEGINER
Well-known Member
- Joined
- Jun 15, 2011
- Messages
- 1,232
Hi All,
In this post I've pasted my vba code and sample image my excel sheet. In below code you can see red color marked part. Problem is in that part. What I'm doing is, Green cells which are gets selected by user get's copy paste in row P,Q,R,S and T. Values which are available in this cells, should get it in Col L cell value.
But it is not working.. Can anyone pls guide my that red color logic part please
[/CODE]
In this post I've pasted my vba code and sample image my excel sheet. In below code you can see red color marked part. Problem is in that part. What I'm doing is, Green cells which are gets selected by user get's copy paste in row P,Q,R,S and T. Values which are available in this cells, should get it in Col L cell value.
But it is not working.. Can anyone pls guide my that red color logic part please
VBA Code:
[CODE=vba]
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Cancel = True
Target.Interior.ColorIndex = 0
End Sub
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Cancel = True
Target.Interior.ColorIndex = 4
End Sub
Private Sub CommandButton1_Click()
Dim rngCell As Excel.Range
Dim rngCount, fnd_Header As Long
Dim rng_B, rng_C, rng_D, rng_E, rng_F As Range
Set rng_B = Range("B3:B" & Range("B" & Rows.Count).End(xlUp).Row)
Set rng_C = Range("C3:C" & Range("C" & Rows.Count).End(xlUp).Row)
Set rng_D = Range("D3:D" & Range("D" & Rows.Count).End(xlUp).Row)
Set rng_E = Range("E3:E" & Range("E" & Rows.Count).End(xlUp).Row)
Set rng_F = Range("F3:F" & Range("F" & Rows.Count).End(xlUp).Row)
rngCount = Sheets("Task Sheet").Range("L" & Rows.Count).End(xlUp).Row
For Each rngCell In rng_B
If rngCell.Interior.Color = RGB(0, 255, 0) Then
Sheets("Task Sheet").Range("P" & rngCount + 1) = rngCell.Value
End If
Next rngCell
For Each rngCell In rng_C
If rngCell.Interior.Color = RGB(0, 255, 0) Then
Sheets("Task Sheet").Range("Q" & rngCount + 1) = rngCell.Value
End If
Next rngCell
For Each rngCell In rng_D
If rngCell.Interior.Color = RGB(0, 255, 0) Then
Sheets("Task Sheet").Range("R" & rngCount + 1) = rngCell.Value
End If
Next rngCell
For Each rngCell In rng_E
If rngCell.Interior.Color = RGB(0, 255, 0) Then
Sheets("Task Sheet").Range("S" & rngCount + 1) = rngCell.Value
End If
Next rngCell
For Each rngCell In rng_F
If rngCell.Interior.Color = RGB(0, 255, 0) Then
Sheets("Task Sheet").Range("T" & rngCount + 1) = rngCell.Value
End If
Next rngCell
Dim lstRw As Long
Dim lstCl As Long
Dim i As Long
Dim j As Long
Dim result As Variant
lstRw = Sheets("Task Sheet").Range("L" & Rows.Count).End(xlUp).Row + 1
[COLOR=rgb(209, 72, 65)]For i = 14 To lstRw
lstCl = Sheets("Task Sheet").Cells(lstRw, Columns.Count).End(xlToLeft).Column
For j = 15 To lstCl
result = result & Sheets("Task Sheet").Cells(i, j) & " "
Next j
Sheet1.Range("L" & i) = result
result = ""
Next i[/COLOR]
Application.ScreenUpdating = False
Sheets("Task Sheet").Select
Range("B3:F50").Select
Selection.Interior.Color = xlNone
Range("A2").Select
End Sub