Duplicate Cells

[jdub21]

When I run my macro based on conditional formatting, it just adds to the bottom when i need it to post in A8. (I highlighted the cells in yellow to show the duplication)

New Vendors by State.xlsm
	C
25
Onboarded

 

[Joe4]

Try stepping through your code one line at a time, while watching what happens on your worksheets.
When you see what is happening, it often becomes obvious what the issue is.
See here for details on how to do this: Stepping Through a Macro with a Worksheet Visible in Excel
(note: Skip Step 3, as that will run your code in its entirety right away, when you actaully just want to step through it).

If you cannot figure it out, please provide us with a simple example that we can use, using XL2BB to post the data from the two sheets in question (just be sure to remove any sensitive data first).

 

[jdub21]

Here is the source sheet that I am pulling from ( all public info nothing private).... I changed to "CA" since it was formatted and had data pertaining to this process..

New Vendors by State.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M
1	Source	Source City	Zip	Company	Date	Name	Phone	Call Result	Trailer	Pricing	Insurance?	Notes	Source
2	Yelp	San Fernando		Prestige Junk Removal			(747) 304-0385	Not interested				Robert said they are too busy to take on more work
3	Yelp	San Fernando		Omar's Hauling			(747) 259-0630	Not interested				Said they are not interested and hung up
4	Yelp	San Fernando		Trash Kings Junk Removal and Haul Away			(818) 850-8101	Jon	17.5cuy	750/load 375/half	Yes	Possible flexibility but only close
5	Yelp	San Fernando		Same Day Hauling & Junk Removal Services			(562) 732-8946	Contacted	25ft	Quote by job - 1000 to 2500 per load		Hung up on me after giving price
6	Yelp	San Fernando		Sontero Junk Removal			(818) 927-9486	Contacted				All he would say is to text a picture no problem. Trouble communicating
7	Yelp	Burbank		Hauling LA Junk Removal Service			(424) 328-5852	Diane				Israel is the owner and will not be in until tomorrow 8/24
8	Yelp	Burbank		CA Junk Hauler			(818) 835-2475	No call, price online		750/load per website
9	Yelp	Burbank		Express Hauling & Junk Removal			(424) 600-3678	Contacted				Hung up as soon as I introduced myself, followed up with a text on vonage
10	Yelp	Burbank		JPZ Haul Away			(424) 360-4310	No Answer				Attempted to leave message but mailbox is full
11	Yelp	Burbank		One Call Junk Haul San Fernando Valley			(818) 873-0080	already on textline		700 lowest price for a load
12	Yelp	Burbank		Honest Abe Junk Removal			(818) 793-2531	Not interested				Said they are not interested and hung up
13	Craigslist	Burbank		Yobany			(818) 200-8857	LVM
CA

 

[jdub21]

This is the destination sheet. When you hit refresh, it runs the macro but nothing pastes.

New Vendors by State.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M
1
2
3
4
5
6
7	Source	Source City	Zip	Date	POC	Company	Phone	Call Result	Trailer/Set up	Pricing	Insurance?	Notes	Sourcer
Onboarded

Here is the code for the macro


Sub CopyOnboarded()

Dim TransIDField As Range
Dim TransIDCell As Range
Dim ATransWS As Worksheet
Dim HTransWS As Worksheet

Set ATransWS = Worksheets("CA")
Set TransIDField = ATransWS.Range("A2", ATransWS.Range("A2").End(xlDown))
Set HTransWS = Worksheets("Onboarded")

' Find last row with data in column A on HTransWS sheet
lr = HTransWS.Cells(Rows.Count, "A").End(xlUp).Row

' Delete data from row 8 down
If lr >= 8 Then
HTransWS.Range("A8:A" & lr).EntireRow.Delete
End If

For Each TransIDCell In TransIDField

If TransIDCell.Interior.Color = RGB(198, 239, 206) Then

TransIDCell.Resize(1, 12).Copy Destination:= _
HTransWS.Range("A1").Offset(HTransWS.Rows.Count - 1, 0).End(xlUp).Offset(1, 0)

End If

Next TransIDCell

HTransWS.Columns.AutoFit

End Sub

 

[jdub21]

I have changed the RGB code to rgb(255, 199, 206) so it pulls the red and still nothing..... New code for the example sheets above



Sub CopyOnboarded()

Dim TransIDField As Range
Dim TransIDCell As Range
Dim ATransWS As Worksheet
Dim HTransWS As Worksheet

Set ATransWS = Worksheets("CA")
Set TransIDField = ATransWS.Range("A2", ATransWS.Range("A2").End(xlDown))
Set HTransWS = Worksheets("Onboarded")

' Find last row with data in column A on HTransWS sheet
lr = HTransWS.Cells(Rows.Count, "A").End(xlUp).Row

' Delete data from row 8 down
If lr >= 8 Then
HTransWS.Range("A8:A" & lr).EntireRow.Delete
End If

For Each TransIDCell In TransIDField

If TransIDCell.Interior.Color = RGB(255, 199, 206) Then

TransIDCell.Resize(1, 12).Copy Destination:= _
HTransWS.Range("A1").Offset(HTransWS.Rows.Count - 1, 0).End(xlUp).Offset(1, 0)

End If

Next TransIDCell

HTransWS.Columns.AutoFit

End Sub

 

[jdub21]

Joe - You are a genius and appreciate your patience with me. I made the most basic newb mistake that will haunt me for the rest of my days....... I forgot to hit save..... Everything is now working beautifully.

 

[Joe4]

Glad we got it all sorted!

 

[jdub21]

Joe - I keep running into timeout errors or excel just crashes...... I know that it is the fact that I have 50 sheets to run through...... Is there anything I can do to speed up the process. Right now I have duplicated the process 50 times to go and check each sheet which I know that there is an easier way. Please guide me obi wan.

 

[Joe4]

Joe - I keep running into timeout errors or excel just crashes...... I know that it is the fact that I have 50 sheets to run through...... Is there anything I can do to speed up the process. Right now I have duplicated the process 50 times to go and check each sheet which I know that there is an easier way. Please guide me obi wan.

I refer you back to the advice I gave back in post 9: Duplicate Cells