Complicated Project

VBAnewbie7

New Member
Joined
Aug 24, 2019
Messages
7
I'm new to VBA and so far i've mostly copied other macros and adjusted them to my needs. So i don't fully understand the language.

I deal with A LOT of data at work, usually a table with thousands of rows of data, and about a dozen columns. I always have to filter the data on a specific item code, then copy and paste that into a new worksheet as sort of a "snapshot" of the data that corresponds to that item code.

Is there a way with VBA to create a tool to where i could put the entire table of data onto a "control" sheet and then have a macro individually run a filter on each item code, create a "snapshot" (copy and paste the filtered table as values) to a newly created sheet, maybe even with that item code as the new sheet name?

Examples of item codes are AA, BB, CC, DD, and roughly 20 others.
Examples of data that corresponds to these item codes are labor hours, charge numbers, activity IDs, etc.

I know this is really complicated, but it would save me literally hundreds of hours. Any help at all is greatly appreciated! And if something like this has already been answered please point me in the direction and i will happily figure it out. Everything i've found so far though i have not been skilled enough to change it to meet this specific need.
 

Excel Facts

Formula for Yesterday
Name Manager, New Name. Yesterday =TODAY()-1. OK. Then, use =YESTERDAY in any cell. Tomorrow could be =TODAY()+1.
Welcome to Mr. Excel

As JoeMo said, with so little details it would mean that we have to make some assumption that may not be correct. Try the below VBA code, I am assuming your data starts in row 1 … Let us know how it goes

Code:
Sub SheetPerItem()
Application.ScreenUpdating = False
Dim ArList As Object, Ar As Variant, Col As Long, Ws As Worksheet
Dim ColName As String, lRow As Long, Rg As Range
Set ArList = CreateObject("System.Collections.ArrayList")
Set Ws = ActiveSheet
Col = Application.InputBox("Please click the column where the item code is located", Type:=8).Column
Ar = ActiveSheet.Range("A1").CurrentRegion
ColName = Ws.Cells(1, Col)
lRow = UBound(Ar)
For x = 2 To UBound(Ar)
    If Not ArList.contains(Ar(x, Col)) Then ArList.Add Ar(x, Col)
Next
ReDim Ar(1 To ArList.Count): Ar = ArList.ToArray
For x = 0 To UBound(Ar)
    Sheets.Add(after:=Sheets(Sheets.Count)).Name = Ar(x)
    Set Rg = Ws.Cells(lRow + 2, Col).Resize(2)
    Rg = Application.Transpose(Array(ColName, Ar(x)))
    Ws.[A1].CurrentRegion.AdvancedFilter xlFilterCopy, Rg, Sheets(Ar(x)).[A1]
Next
Rg.Delete
Application.ScreenUpdating = True
End Sub
 
Upvote 0
Welcome to Mr. Excel

As JoeMo said, with so little details it would mean that we have to make some assumption that may not be correct. Try the below VBA code, I am assuming your data starts in row 1 … Let us know how it goes

Code:
Sub SheetPerItem()
Application.ScreenUpdating = False
Dim ArList As Object, Ar As Variant, Col As Long, Ws As Worksheet
Dim ColName As String, lRow As Long, Rg As Range
Set ArList = CreateObject("System.Collections.ArrayList")
Set Ws = ActiveSheet
Col = Application.InputBox("Please click the column where the item code is located", Type:=8).Column
Ar = ActiveSheet.Range("A1").CurrentRegion
ColName = Ws.Cells(1, Col)
lRow = UBound(Ar)
For x = 2 To UBound(Ar)
    If Not ArList.contains(Ar(x, Col)) Then ArList.Add Ar(x, Col)
Next
ReDim Ar(1 To ArList.Count): Ar = ArList.ToArray
For x = 0 To UBound(Ar)
    Sheets.Add(after:=Sheets(Sheets.Count)).Name = Ar(x)
    Set Rg = Ws.Cells(lRow + 2, Col).Resize(2)
    Rg = Application.Transpose(Array(ColName, Ar(x)))
    Ws.[A1].CurrentRegion.AdvancedFilter xlFilterCopy, Rg, Sheets(Ar(x)).[A1]
Next
Rg.Delete
Application.ScreenUpdating = True
End Sub

I tried it twice with fresh data and it worked fantastic the first time but then i received this error the second time. Any ideas?

7jKzgAAAAASUVORK5CYII=
 
Upvote 0
What was the error message & number & what line of code was highlighted when you click Debug?
 
Upvote 0
The screenshot did not post but it was an error on this line For x = 2 To UBound(Ar)

with the "x" highlighted and a message box that said "Compile error: expected function or variable"
 
Upvote 0
Not quite sure why you would have got that error, if it worked first time round.
Try deleting the code & then copy paste it back in. Do you still get the error?
 
Upvote 0
Why do you need to run the code a 2nd time ? If you do, you should get an error that the same sheet name exists but I'm not sure why you get the error message at that line. Were you in the same sheet that you run the code the 2nd time? Because I'm using ActiveSheet
 
Upvote 0
Not quite sure why you would have got that error, if it worked first time round.
Try deleting the code & then copy paste it back in. Do you still get the error?

I deleted it and copy/pasted it in and got the same error. The line that it is actually highlighting in yellow and pointing to is the very first line "Sub SheetPerItem()" but then highlights the "x" on the "For x = 2 To UBound(Ar)" line as well.

The weird thing is it works fine with a much smaller sample data set on my personal laptop, but then when i copied the macro over to my work laptop to use it with the real data set, this is when i got the error.
 
Upvote 0
Alright, i created a whole new module and typed it out myself and it works now, mostly.

It does the job but then at the very end it creates an "extra" sheet and then hits an error on this line:

Sheets.Add(after:=Sheets(Sheets.Count)).Name = Ar(x)

It is the more typical error of "Run-time error 1004. Application-defined or object-defined error"
This honestly isnt a huge deal as i can just delete the extra sheet but it would be great if it's an easy fix
 
Upvote 0

Forum statistics

Threads
1,213,565
Messages
6,114,338
Members
448,570
Latest member
rik81h

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top