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]

Joe - Thanks for the insight. I have been buried in macro code for the past few years and this one has me stumped. I have dissected other .xlsm files that I have worked with and do the same thing but have found that they are written to replace the file and not just the cell in that worksheet which seemed odd.

Basically I have a workbook that will have 50 tabs (one for each state) and on these sheets, I will have conditional formatting based on their stage in the onboarding process. I want to be able to pull all of the "Green" into one summary tab when I click on the "refresh" button...... but instead of it going to the bottom or next available row, I want it to start in a specific cell "A8"

I would recommend first clearing all the old records from your destination (from row 8 down to the end).
Then the code should put the first one in row 8, and keep working down from there.

 

[jdub21]

Joe - That is my dilemma. When I refresh the summary sheet, it just adds to the bottom as you can see in the screenshot. I just want it to paste in "A8" everytime no matter what.

 

[Joe4]

Joe - That is my dilemma. When I refresh the summary sheet, it just adds to the bottom as you can see in the screenshot. I just want it to paste in "A8" everytime no matter what.

Yes, I am telling you that you need to update your VBA code, specifically this part here, which is finding the last row on that sheet, and pasting below it:

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

So you would have code below you start the loop that deletes all data in rows 8 and below from that sheet, like this:

'   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

 

[jdub21]

I am getting a Compile error: "Next Without For". when I try to run.

---------


Sub CopyOnboarded()

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

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


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)


' 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


Next TransIDCell

HTransWS.Columns.AutoFit

End Sub

 

[Joe4]

I said to put the code BEFORE your loop!
So the whole block of code I gave you needs to go above/before this line:

For Each TransIDCell In TransIDField

 

[jdub21]

Joe - My apologies for being a severe pain in the backside...... So I have moved before the loop. Now do I leave in the following as well or rip that out?

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


----------------------

Here is the new code.


Sub CopyOnboarded()

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

Set ATransWS = Worksheets("AL")
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)



Next TransIDCell

HTransWS.Columns.AutoFit

End Sub

 

[Joe4]

Yes.
Try it out and see if it works!

 

[jdub21]

I still get the Compile error: "Next without For"

 

[Joe4]

Why did you remove the "End If" you had in your original Loop before the "Next TransIDCell" line (see the code you originally posted in post 6)?
Nothing should change in your code between the "For" and "Next" lines. Keep what you originally had there.
You are just pasting the block of code I gave you BEFORE the "For" line.

 

[jdub21]

Here is the new code. No errors but does not paste anything in "A8" in fact nothing gets pasted.



Sub CopyOnboarded()

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

Set ATransWS = Worksheets("AL")
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