copy paste logic not working in my code

[VBABEGINER]

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=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

[/CODE]

 

[Zot]

I think when you do this
lstRw = Sheets("Task Sheet").Range("L" & Rows.Count).End(xlUp).Row + 1
you get the next empty row after the last occupied row

So,
lstCl = Sheets("Task Sheet").Cells(lstRw, Columns.Count).End(xlToLeft).Column
will give you column A over empty row

Maybe this cause the error?

 

[VBABEGINER]

I think when you do this
lstRw = Sheets("Task Sheet").Range("L" & Rows.Count).End(xlUp).Row + 1
you get the next empty row after the last occupied row

So,
lstCl = Sheets("Task Sheet").Cells(lstRw, Columns.Count).End(xlToLeft).Column
will give you column A over empty row

Maybe this cause the error?

Thanks for reply zot.. but you're asking me question.. I'm confused and unable to find out how this loop will work

 

[Zot]

I did not really look and try to understand the code deeply. Just notice something not right.

I did not really understand your explanation on what you were trying do. Can you brief again point by point?

 

[VBABEGINER]

I did not really look and try to understand the code deeply. Just notice something not right.

I did not really understand your explanation on what you were trying do. Can you brief again point by point?

Col B to F contained data.
May be couple of records will get add, thats different part. as of now we will focus on current list..

On right click event, I will select cells. as soon as I click, cells turns to green color.
Then after clicking on Command button, values which are selected (i.e. in green color cells),
that will get copy-paste from col P and onwards and from row 15 and down..

Hope this is clear..

every time I'll select my values in B to F and click on button.. they will get add from Col P, Q, R, S etc.. (as selection)
and then P,Q,R,S values in combine in Col L cell values..

This is I'm trying to achieve, But cant able to set loop of dim i and j variable..

 

[VBABEGINER]

Hello Members.. anyone pls provide logic on this..

 

[Zot]

My understanding on your goal. Since you are only doing one task at a time, you do not need to loop the row. lstRw is the row you are working on.

Note: I made modification on declaration. Dim rng_B, rng_C, rng_D, rng_E, rng_F As Range means only rng_F As Range but the rest will become Variants. I also removed reference to Sheets("Task Sheet"). The reason it that it is the worksheet macro and referring to the same sheet, thus not necessary.

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 CommandButton_Click()

Dim rngCell As Range
Dim lstRw As Long, fnd_Header As Long
Dim rng_B As Range, rng_C As Range, rng_D As Range, rng_E As Range, rng_F As Range

Application.ScreenUpdating = False

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)

lstRw = Range("L" & Rows.Count).End(xlUp).Row + 1

For Each rngCell In rng_B
    If rngCell.Interior.Color = RGB(0, 255, 0) Then
        Range("P" & lstRw) = rngCell.Value
    End If
Next rngCell
  
For Each rngCell In rng_C
    If rngCell.Interior.Color = RGB(0, 255, 0) Then
        Range("Q" & lstRw) = rngCell.Value
    End If
Next rngCell

For Each rngCell In rng_D
    If rngCell.Interior.Color = RGB(0, 255, 0) Then
        Range("R" & lstRw) = rngCell.Value
    End If
Next rngCell

For Each rngCell In rng_E
    If rngCell.Interior.Color = RGB(0, 255, 0) Then
        Range("S" & lstRw) = rngCell.Value
    End If
Next rngCell

For Each rngCell In rng_F
    If rngCell.Interior.Color = RGB(0, 255, 0) Then
        Range("T" & lstRw) = rngCell.Value
    End If
Next rngCell

Dim lstCl As Long
Dim j As Long
Dim result As Variant

lstCl = Cells(lstRw, Columns.Count).End(xlToLeft).Column
result = ""
For j = 16 To lstCl
    result = result & Cells(lstRw, j) & " "
Next j
Sheet1.Range("L" & lstRw) = result

Sheets("Task Sheet").Select
Range("B3:F50").Select
Selection.Interior.Color = xlNone
Range("A2").Select
Application.ScreenUpdating = True

End Sub

 

[VBABEGINER]

It work.. and also i did some more small changes.. Thank You so much Zot.. Thanks for your valuable time.. ? ?