0 votes
in VBA by Beginner (8 points)

I have been doing a certain process manually for months. Initially, it was just a few minutes of my day, but it's starting to take more time and I was wondering if I could automate it.

 GeorgeBarrySimon
Chicken SandwichYes  
Chicken Nuggets Yes 
Caesar Salad  Yes
Cobb Salad   
Beef BurgerYes  
Cheeseburger Yes 
Bacon & Eggs  Yes
Bacon & Sausages   
Apple Yes 
Oranges   
Orange JuiceYes  
Apple Juice Yes 
Peach crumble  Yes

At the moment, I am filtering column B onwards for non-empty cells, then copying the Column A (or else the orders will be just Yes, Yes, Yes) on to another sheet.

My output would be:

GeorgeBarrySimon
Chicken SandwichChicken NuggetsCaesar Salad
Beef BurgerCheeseburgerBacon & Eggs
Orange JuiceApplePeach Crumble
 Apple Juice 

Would it be possible for a macro to handle all that? I don't know how big the table will be - can I define the last column for it to look for information? Also, could I get it to copy directly to a specific worksheet?

Thank you all!

1 Answer

+1 vote
by Super Expert (2.4k points)
selected by
 
Best answer

Yep, this is possible! The following VBA macro finds the last row and last column of your table and summarizes the non-empty results on a new sheet named "Orders_Clean." Run this macro from the sheet containing the raw data and it will create the new table for you:

Sub FilterFood()
Dim iLastRow As Long, iLastCol As Long
Dim i As Long, j As Long
Dim icount As Long
Dim wsInput As Worksheet, wsOutput As Worksheet
Application.ScreenUpdating = False

'Find the dimensions of the raw table
Set wsInput = ActiveSheet
iLastRow = wsInput.Range("A" & Rows.Count).End(xlUp).Row
iLastCol = wsInput.Cells(1, Columns.Count).End(xlToLeft).Column

'Create a new sheet named "Orders_Clean" and delete old sheet if it exists'
Application.DisplayAlerts = False
On Error Resume Next
Worksheets("Orders_Clean").Delete
Set wsOutput = Worksheets.Add
wsOutput.Name = "Orders_Clean"
Err.Clear
On Error GoTo 0
Application.DisplayAlerts = True

For j = 2 To iLastCol 'loop through each column'
    icount = 1
    wsOutput.Cells(1, j - 1).Value = wsInput.Cells(1, j).Value
    For i = 2 To iLastRow 'loop through each row'
        If Application.Clean(Trim(wsInput.Cells(i, j))) <> "" Then 'if not empty'
            icount = icount + 1
            wsOutput.Cells(icount, j - 1) = wsInput.Cells(i, 1)
        End If
    Next i
Next j

Application.ScreenUpdating = True
End Sub

Instead of using Filters, this macro steps through each cell in your table looking for non-empty cells. If the cell only contains spaces or other whitespace, it will be treated as empty. That's what the Application.Clean and Trim functions are doing in the If statement. 

It'd be interesting to see a speed comparision between a macro like this and one that filters and copies the results. I suspect this will be plenty fast for you, though! :-)

by Beginner (8 points)
That is an awesome thing!!! Ran like a dream!

Where can I shout you a coffee?
by Beginner (8 points)

One other question:

I tried to modify it for another purpose at work. This time, the data I wanted to capture was from Columns D through till Z

I removed iLastCol and changed:

For j = 2 To iLastCol 'loop through each column'

to

For j = 4 To 26

and it posts the results but the output starts from Column C.

What can I do to make it start from A1?

by Super Expert (2.4k points)

I'm so glad it worked for you! To make the output start in Column A, you'll need to make 2 changes.

Change #1:

Replace 

wsOutput.Cells(1, j - 1)

in the For loop at the bottom with:

wsOutput.Cells(1, j - 3)

Change #2:

Replace

wsOutput.Cells(icount, j - 1)

in the For loop at the bottom with:

wsOutput.Cells(icount, j - 3)

 

by Beginner (8 points)
Thank you sooooo much!

Not only did this save me time, also saved me a job!

Welcome to wellsr Q&A
wellsr Q&A is the VBA and Python programming community that rewards you for learning how to code.

Getting Started
Register
VBA Cheat Sheets (On Sale Now)

Earn free prizes for asking VBA and Python questions and for answering questions asked by others in our community.

What makes us different?
Our points system rewards you with a chance for free gifts based on the quality of your questions and answers. All you have to do is post and you could get rewarded, like these members:

runfunke $10 Amazon Gift Card
coolag $10 Amazon Gift Card
Siew Hun $10 Amazon Gift Card

So, why don't you join us? It really is an encouraging way to motivate members in our VBA and Python community.

Register

For more programming tips visit the VBA Tutorials Blog and the Python Tutorials Blog.

...