Macro Question

[goofy78270]

Just as a warning, I am looking to do something weird. I currently have a worksheet that I track pricing changes in. From month to month, I highlight changes for different products based on the investor within a specific color so a second party can ensure that all changes made are correct..

What I would like to do is to have the sheet look at the first adjustment within the list and copy the same values down for each adjustment after that. This isnt so bad seeing as how I can simply say the such and such = the first cell.

The tricky part comes in that I would first like to have the formats copied down to all the following adjustments along with the values.
The second tricky part comes with if the first product is deleted due to whatever reason, I would like to account for this and have the sheet set the next in line as the top and have all others follow it.

I hope that this makes sense. If not, maybe I can upload a workbook for you to see.

 

[goofy78270]

I added this line in to copy the values over...

                    Intersect(.Range("B2:B" & LR).EntireRow, .Columns("D:P")).Value = wks2.Range("B?:N?").Value

This should be a reference to a range("B?:N?") but I am unsure of how to reference the position of the for Loop

        For Each EmpowerID In wks2.Range("A2:A" & wks2.Cells(Rows.Count, "A").End(xlUp).Row)
            If EmpowerID.Interior.ColorIndex <> xlNone Then
                .Range("B1:B" & LR).AutoFilter Field:=2, Criteria1:=EmpowerID
                cnt = 0
                cnt = .Range("B2:B" & LR).SpecialCells(xlCellTypeVisible).Count
                If cnt Then
                    Intersect(.Range("B2:B" & LR).EntireRow, .Columns("D:P")).Value = wks2.Range("B?:N?").Value
                    Intersect(.Range("B2:B" & LR).EntireRow, .Columns("A:P")).Interior.ColorIndex = EmpowerID.Interior.ColorIndex
                End If
            End If
        Next EmpowerID

I have also tried the following while incrementing wks2cnt within the for loop with no success

                    Intersect(.Range("B2:B" & LR).EntireRow, .Columns("D:P")).Value = wks2.Range("B" & wks2cnt & ":N" & wks2cnt).Value

 

[goofy78270]

I got the paste to work although I am not sure if it is the most effective, but at least it works.

I do have a couple of issues though.
1. When I copy over, the first row is overwritten hence the need to copy it at the end - no really a big deal
2. The first time I run this, it is weird. Sometimes, it will highlight the whole page the same as the last row from sheet 2, it will add the first adjustment from the last row to the end of the sheet - although it is highlighted but without anything within the first three columns, or it works fine.

This is what I currently have so I am not sure where the error is coming from.

        wks2cnt = 2
        'Search for all highlighted rows and copy them over
        For Each EmpowerID In wks2.Range("A2:A" & wks2.Cells(Rows.Count, "A").End(xlUp).Row)
            If EmpowerID.Interior.ColorIndex <> xlNone Then
                .Range("B1:B" & LR).AutoFilter Field:=2, Criteria1:=EmpowerID
                wks2.Range("B" & wks2cnt & ":N" & wks2cnt).Copy
                .Paste Destination:=.Range("D:P")
                cnt = 0
                cnt = .Range("B2:B" & LR).SpecialCells(xlCellTypeVisible).Count
                If cnt Then Intersect(.Range("B2:B" & LR).EntireRow, .Columns("A:P")).Interior.ColorIndex = EmpowerID.Interior.ColorIndex
            End If
            wks2cnt = wks2cnt + 1
        Next EmpowerID
        
        'Turn of any remaining autofilter
        .AutoFilterMode = False
        
        'Fix row 1 with headings
        wks2.Range("B1:N1").Copy
        .Paste Destination:=.Range("D1:P1")

 

[erik.van.geit]

Hi,

I tried to put your tables in a workbook, but didn't succees and do not know what kinda exception raised the problem.
Please click "email" below my post and send me the example. Then I can test.

best regards,
Erik

EDIT: as written in PM, these days rather short of time

 

[goofy78270]

I got this to work with a little plug and play but I was wondering if there was a better way to accomplish the copy and paste within the For loop that I currently have?

...
        wks2cnt = 2
        'Search for all highlighted rows and copy them over
        For Each EmpowerID In wks2.Range("A2:A" & wks2.Cells(Rows.Count, "A").End(xlUp).Row)
            If EmpowerID.Interior.ColorIndex <> xlNone Then
                .Range("B1:B" & LR).AutoFilter Field:=2, Criteria1:=EmpowerID
                wks2.Range("B" & wks2cnt & ":N" & wks2cnt).Copy
                .Paste Destination:=.Range("D2:P" & LR)
                cnt = 0
                cnt = .Range("B2:B" & LR).SpecialCells(xlCellTypeVisible).Count
                If cnt Then Intersect(.Range("B2:B" & LR).EntireRow, .Columns("A:P")).Interior.ColorIndex = EmpowerID.Interior.ColorIndex
            End If
            wks2cnt = wks2cnt + 1
        Next EmpowerID
...

As far as the errors, the all highlighting has gone away but the printing after the last row to the end of the sheet still happens from time to time, kinda weird.