copy highlighted data for multiple colors from many sheets to another

[Ali-M]

hello
I have some items in column B contain different color in sheet1,2,3. what I want coping the the whole range for the highlighted item contains color from sheet1,2,3 to sheet COPY except the range in the header and when clear the color from column B in sheet1,2,3 should change by delete the whole range from sheet COPY and if highlight new ranges , then should also copy to sheet2 . with considering when copy data to sheet COPY should sort in column B based on number from small to big
the result in sheet copy .
thanks

[CheeseSandwich]

Hi Ali-M,

I got a little confused with your request so i have done what i think you are trying to do - at least it will be a start:

Please Login or Register  to view this content.

Hope this helps

[Ali-M]

thanks . just I need fixing the headers. the code clear the headers from sheet COPY.

[CheeseSandwich]

Hmm, i had missed a couple of full stops from the code within the With statements - try:

Please Login or Register  to view this content.

[Ali-M]

still clear the headers .
attached file

[CheeseSandwich]

I see what was happening - as the table was empty it was deleting the headers - i have added a check in there now so it will not clear the table if it is already empty:

Please Login or Register  to view this content.

[Ali-M]

seems slow despite of it's simple data , but if even if it's thanks so much

[Marc L]

According to your attachment a VBA demonstration for starters :

Sub Demo1() 
        Dim S&, V, W, L&, R&, C% 
    With Worksheet____2 
        .UsedRange.Offset(1).Clear 
    For S = 1 To .Index - 1 
        With Sheets(S).[A1].CurrentRegion.Columns 
                If S = 1 Then ReDim V(1 To Rows.Count - 1, 1 To .Count) 
                W = .Value2 
            For L = 2 To .Rows.Count 
                If .Cells(L, 2).Interior.ColorIndex <> xlColorIndexNone Then 
                    R = R + 1 
                    V(R, 1) = R 
                    For C = 2 To .Count:  V(R, C) = W(L, C):  Next 
                End If 
            Next 
        End With 
    Next 
        If R Then 
            With .[A2].Resize(R, C - 1) 
                 .Borders.Weight = 2 
                 .Font.Size = .Cells(0, 1).Font.Size 
                 .HorizontalAlignment = xlCenter 
                 .VerticalAlignment = xlCenter 
                 .Value2 = V 
                 .Columns(2).Resize(, C - 2).Sort .Cells(2), 1, Header:=2 
            End With 
        End If 
    End With 
End Sub  

► Do you like it ? ► ► So thanks to click on bottom left star icon « ★ Add Reputation » ! ◄ ◄

[Marc L]

According to your last attachment just replace in my VBA demonstration Worksheet____2 with sheet2 …

[Ali-M]

@Marc L much appreciated for your code . this better , but I have problem about number format . it deosn't show like this 1,200.00 or 120.00 even if I use manually by using cell format . the code deletes it . may you fix it please?

[Marc L]

Thanks for the rep' !

Sub Demo1() 
        Dim S&, V, W, L&, R&, C% 
    With sheet2 
        .UsedRange.Offset(1).Clear 
    For S = 1 To .Index - 1 
        With Sheets(S).[A1].CurrentRegion.Columns 
                If S = 1 Then ReDim V(1 To Rows.Count - 1, 1 To .Count) 
                W = .Value2 
            For L = 2 To .Rows.Count 
                If .Cells(L, 2).Interior.ColorIndex <> xlColorIndexNone Then 
                    R = R + 1 
                    V(R, 1) = R 
                    For C = 2 To .Count:  V(R, C) = W(L, C):  Next 
                End If 
            Next 
        End With 
    Next 
        If R Then 
            With .[A2].Resize(R, C - 1).Columns 
                 .Borders.Weight = 2 
                 .Font.Size = .Cells(0, 1).Font.Size 
                 .HorizontalAlignment = xlCenter 
                 .Item("F:H").NumberFormat = Sheets(1).[F2].NumberFormat 
                 .VerticalAlignment = xlCenter 
                 .Value2 = V 
                 .Item("B:H").Sort .Cells(2), 1, Header:=2 
            End With 
        End If 
    End With 
End Sub  

[Marc L]

According to Excel basics the filter VBA demonstration :

Sub Demo2() 
        Dim S&, T&, R& 
    With sheet2 
       .UsedRange.Offset(1).Clear 
        Application.ScreenUpdating = False 
    For S = 1 To .Index - 1 
        With Sheets(S).UsedRange.Columns("B:H") 
            .Item(8).Value2 = 1 
            .Item(1).AutoFilter 1, , 12 
            .Item(8).SpecialCells(12).Value2 = 0 
            .AutoFilter 
             T = Application.Sum(.Item(8)) 
          If T Then 
            .Item(8).AutoFilter 1, 1 
            .Offset(1).Copy sheet2.Cells(R + 2, 2) 
            .AutoFilter 
             R = R + T 
          End If 
            .Item(8).Clear 
        End With 
    Next 
    If R Then 
        With .UsedRange.Rows("2:" & R + 1).Columns 
             .Item(2).Interior.ColorIndex = xlColorIndexNone 
             .Sort .Item(2), 1, Header:=2 
             .Item(3).Copy .Item(1) 
             .Item(1).Value2 = Evaluate("ROW(1:" & R & ")") 
        End With 
    End If 
        Application.ScreenUpdating = True 
    End With 
End Sub  

► Do you like it ? ► ► So thanks to click on bottom left star icon « ★ Add Reputation » ! ◄ ◄

[Ali-M]

just curiosity , I heard from some members the filtering way is better choice than any other way about the speed if the data is big , but I tested it and gives the same running speed 0.1 as in post#11 . what the main reason you think ?

[Marc L]

All I can say :

• On my side with your attachment as it is Demo2 is a very little bit faster than Demo1, just by eyes,
  even with the screen updating desactivated in Demo1 …
  
  
• So it may depend on the Excel version - my tests are under Excel 2010 - and on the computer as well (old slow for my tests).
  
  
• But for sure Excel features like worksheet functions, filter, advanced filter, sort, … are already compiled
  so faster than any bad looping VBA code which must be interpreted then pre-compiled before its execution …
  I saw a kid - summer job - operating manually a huge table just with Excel basics faster than a bad looping code !
  
  
• And obviously it depends on the logic used like copying cell by cell is slower than copying block of rows …

What is the best code ?

The faster ? Not always … but the one you understand, the easier to maintain by yourself !
Imagine for some reason your office does not have any net connection
but your boss asks you an urgent 'little mod' and expects a result in the next half hour, you well see now !

[Ali-M]

@thanks Marc L