Vba Code To Extract Files

[singupalli]

Hi

I need help.

I have a data base "Inventory" where all records are recorded

I have Data
Date/Item/Type of sale/INVAmt/Rct/amt/Customet Name

Under type of sale i have transactions "Cash" CC"Credit"

I would like to know if there is a Formula or a VBA code to extract all data
Pertaining to "cash" to another sheet
and for CC to another sheet
and so on for all type of sale

and also that these sheets are updated as and when the data base sheet is being updated.

Please assist

Thank you
prasad

 

[singupalli]

hi

i need help.

I have a data base "inventory" where all records are recorded

i have data
date/item/type of sale/invamt/rct/amt/customet name

under type of sale i have transactions "cash" cc"credit"

i would like to know if there is a formula or a vba code to extract all data
pertaining to "cash" to another sheet
and for cc to another sheet
and so on for all type of sale

and also that these sheets are updated as and when the data base sheet is being updated.

Please assist

thank you
prasad

urgent help please

 

[Domenic]

The following macro assumes that Row 1 contains the column headers, and that the data starts at Column A. Note that each set of data is copied to a worksheet named after the type of sale. If such a worksheet does not already exist, a new worksheet is added and named accordigly.

[font=Verdana][color=darkblue]Option[/color] [color=darkblue]Explicit[/color]

[color=darkblue]Sub[/color] SplitData()

    [color=darkblue]Dim[/color] wksSource [color=darkblue]As[/color] Worksheet
    [color=darkblue]Dim[/color] wksDest [color=darkblue]As[/color] Worksheet
    [color=darkblue]Dim[/color] UniqueVals [color=darkblue]As[/color] Range
    [color=darkblue]Dim[/color] Cell [color=darkblue]As[/color] Range
    [color=darkblue]Dim[/color] LastRow [color=darkblue]As[/color] [color=darkblue]Long[/color]
    [color=darkblue]Dim[/color] Cnt [color=darkblue]As[/color] [color=darkblue]Long[/color]
    
    Application.ScreenUpdating = [color=darkblue]False[/color]

    [color=darkblue]Set[/color] wksSource = Worksheets("Sheet1")
    
    [color=darkblue]With[/color] wksSource
        LastRow = .Cells(.Rows.Count, "C").End(xlUp).Row
        [color=darkblue]If[/color] LastRow > 1 [color=darkblue]Then[/color]
            .Range("C1:C" & LastRow).AdvancedFilter xlFilterInPlace, , , [color=darkblue]True[/color]
            [color=darkblue]Set[/color] UniqueVals = .Range("C2:C" & LastRow).SpecialCells(xlCellTypeVisible)
        [color=darkblue]Else[/color]
            MsgBox "No data is available...", vbExclamation
            [color=darkblue]GoTo[/color] ExitSub
        [color=darkblue]End[/color] [color=darkblue]If[/color]
    [color=darkblue]End[/color] [color=darkblue]With[/color]
    
    [color=darkblue]For[/color] [color=darkblue]Each[/color] Cell [color=darkblue]In[/color] UniqueVals
        Cnt = Cnt + 1
        [color=darkblue]If[/color] [color=darkblue]Not[/color] Evaluate("ISREF('" & Cell.Value & "'!A1)") Then
            [color=darkblue]Set[/color] wksDest = Worksheets.Add(before:=Worksheets(Cnt))
            wksDest.Name = Cell.Value
        [color=darkblue]Else[/color]
            [color=darkblue]Set[/color] wksDest = Worksheets(Cell.Value)
            wksDest.Cells.Clear
        [color=darkblue]End[/color] [color=darkblue]If[/color]
        [color=darkblue]With[/color] wksSource
            [color=darkblue]With[/color] .Range("A1:H" & LastRow)
                .AutoFilter field:=3, Criteria1:=Cell.Value
                .Copy Destination:=wksDest.Range("A1")
            [color=darkblue]End[/color] [color=darkblue]With[/color]
        [color=darkblue]End[/color] [color=darkblue]With[/color]
    [color=darkblue]Next[/color] Cell
    
    wksSource.AutoFilterMode = [color=darkblue]False[/color]
    
ExitSub:
    Application.ScreenUpdating = [color=darkblue]True[/color]
    
    [color=darkblue]If[/color] Cnt > 0 [color=darkblue]Then[/color]
        MsgBox "Completed...", vbInformation
    [color=darkblue]End[/color] [color=darkblue]If[/color]
    
[color=darkblue]End[/color] [color=darkblue]Sub[/color]
[/font]

 

[singupalli]

Hi Domenic

Thank you for the code

i added the code in my existing code and i get an error
"Only Comments may appear after end sub, end function, end property"

please help

thank you

prasad

 

[Domenic]

Can you post the exact code you're using?

 

[singupalli]

Hi Domenic

this is the code i entered

My data sheet "inventory"
Columns A to N
Date, Item, Type Of Sale,Qty,Retail rate, Retail Value, Do nbr......& Until Column N

i want to extract and input date from "Invetorty" sheet to different sheets Based of Type of sales

i use the below code and getting a compile Error

Please help






Option Explicit
Sub SplitData()
Dim wksSource As Worksheet
Dim wksDest As Worksheet
Dim UniqueVals As Range
Dim Cell As Range
Dim LastRow As Long
Dim Cnt As Long

Application.Screen Updating = False
Set wksSource = Worksheets("Inventory")

With wksSource
LastRow = .Cells(.Rows.Count, "C").End(xlUp).Row
If LastRow > 1 Then
.Range("C1:C" & LastRow).AdvancedFilter xlFilterInPlace, , , True
Set UniqueVals = .Range("C2:C" & LastRow).SpecialCells(xlCellTypeVisible)
Else
MsgBox "No data is available...", vbExclamation
GoTo ExitSub
End If
End With

For Each Cell In UniqueVals
Cnt = Cnt + 1
If Not Evaluate("ISREF('" & Cell.Value & "'!A1)") Then
Set wksDest = Worksheets.Add(before:=Worksheets(Cnt))
wksDest.Name = Cell.Value
Else
Set wksDest = Worksheets(Cell.Value)
wksDest.Cells.Clear
End If
With wksSource
With .Range("A1:n" & LastRow)
.AutoFilter field:=3, Criteria1:=Cell.Value
.Copy Destination:=wksDest.Range("A1")
End With
End With
Next Cell

wksSource.AutoFilterMode = False

Exit Sub:
Application.ScreenUpdating = True

If Cnt > 0 Then
MsgBox "Completed...", vbInformation
End If

End Sub

 

[Domenic]

It looks like you have an unwanted space in a couple of places. You'll need to replace...

Application.Screen Updating = False

with

Application.ScreenUpdating = False

and

Exit Sub:

with

ExitSub:

 

[singupalli]

Hi Domenic

thanks a ton
it worked

however, when i make the data entry from the user form, the new data is listed in the data basesheet "Inventory" but the there is no update of the works sheets like "cash" "credit card sales" etc

regards
prasad

 

[Domenic]

When running the macro, each set of data is copied from the source worksheet and pasted to their respective sheets. If a sheet does not already exist, one is created. If one already exists, the data in the destination worksheet is first cleared, and then the old data along with the new data from the source worksheet is copied/pasted to their respective sheets. When new data is added to the source worksheet and the macro is run again, the process is repeated.

Is this the desired result?

Does Row 1 contain the column headers?

Does Column C contain the 'Type of Sale'?

Can you post a small sample of the data from the source worksheet?

 

[singupalli]

Hi Domenic

Its working fantastic

Thanks a lot
prasad