Create a Sorted List of unsorted cells based on color of next cell into a new sheet.

[tejprn]

Dear Forum Members, I am looking for a solution to this. I am totally new to vba in excel but have experimented once or twice in the past few years. If there are any alternative solutions, I am open to all.

Version of the program
Excel 2016


What I want it to do
Short Version: Copy and arrange only those cells of Column A which are adjacent to cells in blue color font of Column B in a list form to a new sheet.


Long Version:
I have the following data;
Excel files - 26
Sheets in each file - 26
Columns in each sheet - 2(No headers)
Font colors used - 3
Rows in each sheet - Thousands


Column A has data and Column B has corresponding entries with specific font color for easy identification. Although the list has an order but as of now, the cells with a different color are not in sequence. I am looking for simplest/fastest way to make a list of all copied cells which have cells with blue color font next to them.


What I would love to happen:
Get one big list of maybe thousands entries from these 26 excel files.


My approach: Use VBA
1. Create a new sheet named List at the beginning of the sheet.
2. Use filter as it shows only filtered entries instead of custom sort which although arranges but also has other entries below. I don't know a way to select only blue font cells.
3. Copy the whole sheet data.
4. Paste copied data into "List" sheet.
5. Move one row below the last row of data for new data.
6. Create some sort of loop to process Step 2 to Step 5 on all sheets in the file.
7. Copy "List" contents separately for each file preferably using code or else manually.


Work Done: Please review my code which is nothing but a mix of code snippets copied, learnt and adjusted from different sources.


Sub CopyListToNewSheet()
Application.ScreenUpdating = False 'Stop screen flashing during working.
ActiveWorkbook.Sheets(1).Activate 'Select first sheet.
ActiveWorkbook.Sheets.Add.Name = "List" 'Add a new sheet named LIST before first sheet.
ActiveWorkbook.Sheets(2).Activate 'Select second sheet.
Application.CutCopyMode = False 'Purge existing clipboard.

For Each sh In ActiveWorkbook.Worksheets 'Apply process to all sheets in workbook.
sh.Activate
On Error Resume Next 'Ignore blank/sheets without color.

Selection.AutoFilter 'Apply filter.
ActiveSheet.Range("$A:$B").AutoFilter Field:=2, Criteria1:=RGB(0, 0, _
255), Operator:=xlFilterFontColor 'Filter cells with blue color font.
Range("A:B").Select 'Select columns
Selection.Copy
Sheets("List").Select 'Select newly created sheet to paste data
ActiveSheet.Paste
Selection.End(xlDown).Offset(1, 0).Select 'Move 1 row below the last row of the data for new data.
Next
Application.ScreenUpdating = True 'Updating screen with results.
End Sub



ISSUE: Excel doesn't apply the filter on the first row but all the rows below it. This creates one row of unwanted data from each sheet in the final list.


Sample File: Blue Font Color Cells To List_Sample.xlsx

Please excuse any misunderstandings as English is not my first language. Hope you all understand.
Thanks for taking time to read my post.

[Aussiebear]

Welcome to VBAX tejprn. The workbook that you supplied lacks any real data and no coloured cells for us to see what you are facing. Can you please upload another workbook with better detail.

[p45cal]

Some code to adapt to your needs:
Set destn = Sheets("List").Cells(1) 'set the first destination
With ActiveSheet
.Rows(1).Insert 'add a row at top for autofilter
.Range("A:B").AutoFilter Field:=2, Criteria1:=RGB(0, 0, 255), Operator:=xlFilterFontColor 'filter
With .AutoFilter '
Intersect(.Range, .Range.Offset(1).Resize(, 1)).Copy destn 'does the copying
Set destn = Sheets("List").Cells(Rows.Count, 1).End(xlUp).Offset(1) 'set a new destination for the next copy
End With
.Rows(1).Delete 'deletes the first row that was added earlier, which also removes the autofilter.
End With

[tejprn]

Hi Aussiebear,
I just checked the attachment. There are 2 sheets in it. "Sheet1" contains the data to be worked upon with color font. Sheet "List" has been created as an example of the results I intend to generate from "Sheet1".

Thanks for the reminder but I had gone through the forum rules where it directed me to click hash(#) on the selected code or manually add it. I am sorry if it didn't go through even though I clicked it and saw the modifiers Code].... [/Code with square brackets appear before posting.
I haven't posted to any other forums. I will check answers here as they come.

BTW, the forum text editor shows "Auto-Saved" at the bottom of the window. Do you know how to access this saved writeup? I lost entire page due to timeout but couldn't figure out, how to access the same.:(

[Aussiebear]

Sorry the Autosaved function is outside my pay grade. Did you check P45cal's code for functionality?

[tejprn]

Seems to work. Checking with full data, will post results.

[tejprn]

Hi p45cal,
Thanks a lot for providing the direction. Sorry for the late reply but I wanted to test it thoroughly before I came back here. I processed 1 out of the 26 files manually and compared the results.
I adapted the code to the best of my understanding but I think that is still the culprit here.

Here are my observations, as there are some hiccups.

1. When there is No blue cell in the list, it prints the whole list(There should be no entry, not even a blank cell in the "List".)
2. When the blue cells have a corresponding non-blank cell in the list, it gives results as intended but only for that cell.
3. When the blue cells have a corresponding blank cell in the list, it gives perfect results(It creates a Blank cell in the "List"), when then macro is run only on a single sheet but surprisingly the results are weird(Mostly there is no entry, except 1-2 places) when it is run on workbook containing multiple sheets.
4. I guess there is some issue with *My Code, the order in which it handles/processes the sheets. Sorry, I don't know much but looks like something comes out of order when multiple sheets are worked together.
5. Please review my code for possible errors/loopholes etc.
6. Attaching 2 sample files to play around and see what I described in Steps1-3.
7. The Macro should create a replica of the cell corresponding to the cell with blue color font no matter whether the corresponding cell is Blank, Cell with Color, Any font...etc anything.

My full code after your given code snippet.


Sub VBAXForum()


Application.ScreenUpdating = False 'Stop screen flashing during working.
ActiveWorkbook.Sheets(1).Activate 'Select first sheet.
ActiveWorkbook.Sheets.Add.Name = "List" 'Add a new sheet named LIST before first sheet.
ActiveWorkbook.Sheets(2).Activate 'Select second sheet.
Application.CutCopyMode = False 'Purge existing clipboard.
Set destn = Sheets("List").Cells(1) 'set the first destination

For Each sh In ActiveWorkbook.Worksheets 'Apply process to all sheets in workbook.
sh.Activate
On Error Resume Next 'Ignore blank/sheets without color.

With ActiveSheet
.Rows(1).Insert 'add a row at top for autofilter
.Range("A:B").AutoFilter Field:=2, Criteria1:=RGB(0, 0, 255), Operator:=xlFilterFontColor 'filter
With .AutoFilter '
Intersect(.Range, .Range.Offset(1).Resize(, 1)).Copy destn 'does the copying
Set destn = Sheets("List").Cells(Rows.Count, 1).End(xlUp).Offset(1) 'set a new destination for the next copy
End With
.Rows(1).Delete 'deletes the first row that was added earlier, which also removes the autofilter.
End With

Application.ScreenUpdating = True 'Updating screen with results.
Next
End Sub

[p45cal]

Test:
Sub VBAXForum()
Dim CellsToCopy As Range, SuccessfulFilter
Application.ScreenUpdating = False 'Stop screen flashing during working.
With ActiveWorkbook 'this routine add a List sheet to the active workbook and processes only that workbook.
Set NewSht = .Sheets.Add(before:=.Sheets(1)) 'Add a new sheet as the first sheet
NewSht.Name = "List" 'name new sheet LIST
Set destn = NewSht.Cells(1) 'set the first destination
For Each sh In .Worksheets 'Apply process to all sheets in workbook.
If Not NewSht Is sh Then 'skip sheet if it's the new List sheet.
With sh
.Rows(1).Insert 'add a row at top for autofilter
SuccessfulFilter = False 'default; will be True later if an autofilter was successfully applied
On Error Resume Next 'for when an autofilter cannot be successfully applied.
SuccessfulFilter = .Range("A:B").AutoFilter(Field:=2, Criteria1:=RGB(0, 0, 255), Operator:=xlFilterFontColor) 'filter
On Error GoTo 0 'return to normal error handling
If SuccessfulFilter Then 'only process if a succesful filter
With .AutoFilter
Set CellsToCopy = Nothing
On Error Resume Next 'for when no cells are found
Set CellsToCopy = Intersect(.Range, .Range.Offset(1).Resize(, 1)).SpecialCells(xlCellTypeVisible)
On Error GoTo 0 'return to normal error handling
If Not CellsToCopy Is Nothing Then 'only do copying etc. when there are cells to copy
CellsToCopy.Copy destn 'does the copying
Set destn = destn.Offset(CellsToCopy.Count) 'set a new destination for the next copy
End If
End With
End If
.Rows(1).Delete 'deletes the first row that was added earlier, which also removes the autofilter.
End With
End If
Next sh
End With
Application.ScreenUpdating = True 'Updating screen with results.
End Sub

This adds a sheet to the active workbook and only processes that workbook.
Regarding processing many workbooks:
One list, but in which workbook? The separate workbook with the vba code in?
Where are the workbooks that need to be processed? All in the same folder? Do they need to be opened or are they already open?

[tejprn]

Oh, wow, thanks for the quick reply. I really appreciate it p45cal. Just got back from the market and saw your reply.

This adds a sheet to the active workbook and only processes that workbook. - Good, serves the purpose. This is what I originally planned - adding a new sheet named "List" which gets all the entries from all the existing sheets.
I know we have to redo this if we plan to make it work on multiple workbooks/excel files but that's the best preferred thing.

Regarding processing many workbooks:
One list, but in which workbook? - If one full list is possible for all the 26 excel files(which happen to be in one folder and similarly named), I think its better if we create a Separate Workbook for the Final List.
The separate workbook with the vba code in? - I have my vba code in a PERSONAL excel file. I guess its not required to be present in our Ans - Final List although I understand PERSONAL need to be in open mode anytime we want to use the code.
Where are the workbooks that need to be processed? All in the same folder? - Yes, all are/can arranged in one folder.
Do they need to be opened or are they already open? - It would be best if the user need not open them one by one but can either select through a pop-up/hard code the folder path in the code.



This adds a sheet to the active workbook and only processes that workbook.
Regarding processing many workbooks:
One list, but in which workbook? The separate workbook with the vba code in?
Where are the workbooks that need to be processed? All in the same folder? Do they need to be opened or are they already open?

[p45cal]

I would have a workbook dedicated to producing/updating the List sheet, in that same workbook. I wouldn't put code in the PERSONAL workbook.
I may get time to do something later today, but if I don't it will be next weekend before I can do anything.
I'll write some code to allow you either just to select a folder and all Excel files within that folder will be processed, or to select multiple files within a single folder and process only those selected files. In either case, the files won't need to be open beforehand.

[tejprn]

Great! Thanks for the update.
Yes, I agree code in the PERSONAL workbook is a kind of hassle.
btw, the latest code iteration provided by you worked FLAWLESSLY. If there wouldn't have been more files, I would have selected this as the answer.

Once again, I understand the time constraints and appreciate with everything you are helping me with. Now, that the code is working as expected, I think I can give it a try to include other files/folder. I will update if I get somewhere.:)

[p45cal]

In the attached, button on sheet1 runs macro MakeBigList.
When presented with the dialogue to select files you can navigate to a folder and select the files therein that you want to process. The usual mouse and keyboard key press combinations apply; holding down the Ctrl key while selecting files allows you select/unselect individual non-contiguous files, holding down the Shift key allows you to select many contiguous files, holding down Ctrl and pressing the letter a selects all the files etc.
Cancelling or just closing the dialogue will not process any files.
Each workbook is opened, processed, then closed without saving any changes.
For debugging/testing purposes, there's a line of code beginning destn.Resize(CellsToCopy.Count).Offset(, 1).Value = which adds workbook name and sheet name in column B of the List sheet; you can disable this line by prefixing it with an apostrophe (or deleting it).
There's nothing to check for a pre-existing List sheet, the code will throw an error if there is one. You can safely End the macro at this point.

[tejprn]

Hi P45cal,
Hope you are doing good.
Thanks for the code file. It worked as expected on almost all of the files. I got the work done, say about 99% except one irritating bug. I researched a bit about the same and here are my findings.
*Please don’t fret about it and overwork yourself if this bug cannot be resolved in a simple manner as it is just less than 1% of data and can be done manually, but I was curious if it can be covered in error handling in some way.


Short Conclusion: The code throws an error on worksheets where there is just ONE Line of data with No Blue Font cells(A1 is a non blank & B1 is a Non-blue, non blank). If there are any blank cells counted in the used range, it increases the tally to more than 1 row used, thus no error in such cases.


Observations:
1. Ran 676 worksheets spread over 26 files and got Error(1) attached - "Copy area and paste area aren't the same size".
2. Checked vba code and it was stuck at Step(1) attached - "CellsToCopy.Copy destn".
3. Separated the worksheets giving errors and found 4 culprits - All 4 had one line of data and no blue font cell.
4. Ran your code only on these 4 individual files and got Error(2) attached - "Overflow".
5. Checked vba code and it was stuck at Step(2) attached - "destn.Resize(CellsToCopy.Count)...".
6. When the code threw the error, checked "List" sheet and after doing Ctrl+End, the last cell was showing as B1048575.
7. Checked the open file when stuck at the error, and the last cell was showing as B1048576.
8. It seems the way the code works, forces it to select the last row of Excel as the last row of data/used range thereby attempting to copy 1048576 rows into "List" and also setting new destination as 1 row below it, which seems impossible given there are no more rows left in excel.
9. We get this error when, A1 is non-blank and B1 is non-blue font and there are no more rows of data not even blanks making the total used rows to just 1.

[p45cal]

Can you attach the 4 errant sheets in a single workbook here?

[tejprn]

Attached. In fact we can simply recreate the error by making a new worksheet and just put one row of data in A&B columns ensuring non-blue font is selected in the B column.

I think I am good with whatever we have now. Let me know whenever I can mark the thread as solved. :)


Can you attach the 4 errant sheets in a single workbook here?

[Aussiebear]

I think I am good with whatever we have now. Let me know whenever I can mark the thread as solved. :)

You can mark your thread solved as soon as you are satisfied.

[tejprn]

Thanks a ton p45cal. I could get this long pending work done, all because of you. Really appreciate your time and efforts.

[p45cal]

Try changing this line to:

Set CellsToCopy = Intersect(.Range, .Range.Offset(1)).SpecialCells(xlCellTypeVisible).Resize(, 1)
The .Resize has been moved to the end of the line.

When range.Specialcells is executed and range is a single cell, .Specialcells operates on the whole sheet, instead of restricting itself to the visible cells of the selection.
You can demonstrate this yourself by having an autofilter somewhere on the sheet which hides some rows, then selecting a single cell anywhere on the sheet, then pres F5 on the keyboard, click Special… then choose Visible cells only, then click OK.