copy paste logic not working in my code

VBABEGINER

Well-known Member
Joined
Jun 15, 2011
Messages
1,163
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

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
[/CODE]

Example.jpg
 

Excel Facts

Using Function Arguments with nested formulas
If writing INDEX in Func. Arguments, type MATCH(. Use the mouse to click inside MATCH in the formula bar. Dialog switches to MATCH.

Zot

Well-known Member
Joined
Nov 26, 2020
Messages
1,618
Office Version
  1. 2016
Platform
  1. Windows
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

Well-known Member
Joined
Jun 15, 2011
Messages
1,163
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

Well-known Member
Joined
Nov 26, 2020
Messages
1,618
Office Version
  1. 2016
Platform
  1. Windows
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

Well-known Member
Joined
Jun 15, 2011
Messages
1,163

ADVERTISEMENT

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

Zot

Well-known Member
Joined
Nov 26, 2020
Messages
1,618
Office Version
  1. 2016
Platform
  1. Windows
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.
VBA Code:
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
 
Last edited:
Solution

VBABEGINER

Well-known Member
Joined
Jun 15, 2011
Messages
1,163
It work.. and also i did some more small changes.. Thank You so much Zot.. Thanks for your valuable time.. 👏 (y) 🕺
 

Forum statistics

Threads
1,141,715
Messages
5,708,058
Members
421,541
Latest member
Akidev

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top