Extracting Data from Main Sheet through Macros..

[damanirahul]

I have 6 columns each for Date, Script, Quantity, Rate, Amount, and Client.
Everyday I fill the data in this main sheet1.
A sample of sheet1 is as follows-

Date Script Quantity Rate Amount Client

1-Jul-11 ABC Ltd 100 105.00 10500.00 A
1-Jul-11 CDE Ltd -50 97.00 -4850.00 B
1-Jul-11 FGH Ltd 100 88.00 8800.00 B
2-Jul-11 IJK Ltd -25 115.00 -2875.00 C
2-Jul-11 ABC Ltd 500 115.00 57500.00 A
2-Jul-11 CDE Ltd -200 79.00 -15800.00 B
2-Jul-11 FGH Ltd 500 86.00 43000.00 A
2-Jul-11 ABC Ltd 100 108.00 10800.00 C
3-Jul-11 CDE Ltd -200 84.00 -16800.00 C
3-Jul-11 IJK Ltd 100 117.00 11700.00 C



This is sample of how my worksheet1 looks like, which I fill everyday.
I want in sheet 2 all the transactions done by A should come date wise automatically, and in sheet3 the details of client C and so on. Please can you help me how to do it?
Hope I will get quick and positive reply to my query. Thanks in advance 

 

[damanirahul]

I request board members to help me on this, its urgent>>
Thanks in advance!

 

[Yahya]

Try this code

Sub Test2()
    Dim LR As Long, ws As Worksheet, ACell As Range
    Set ws = Sheets("sheet1")
    Set ACell = ActiveCell.CurrentRegion
    LR = ws.Range("a" & Rows.Count).End(xlUp).Row
    With ws.Range("A1:F" & LR)
        .AutoFilter 6, "A"
    ACell.Copy Sheets("sheet2").Range("a1")
        .AutoFilter 6, "B"
    ACell.Copy Sheets("sheet3").Range("a1")
        .AutoFilter 6, "C"
    ACell.Copy Sheets("sheet4").Range("a1")
    ws.Range("A1:F" & LR).AutoFilter
    End With
End Sub

HTH

 

[Rick Rothstein]

I'm guessing your client's names are not A, B, C, etc., so I am going to have to make some assuptions. I have assumed you have sheets named for the each client, so I have written the client's data to the sheet named for the client. I have also assumed that the client's sheets are always blank when you run this macro. With those assumptions in mind, give this macro a try...

Sub SplitOutData()
  Dim UnusedCol As Long, LastRow As Long, NextLetter As Range, Addr As String, Text As String
  Const StartRow As Long = 2
  LastRow = Cells(Rows.Count, "A").End(xlUp).Row
  UnusedCol = Cells.Find(What:="*", SearchOrder:=xlByColumns, _
              SearchDirection:=xlPrevious, LookIn:=xlFormulas).Column + 1
  Range(Cells(StartRow, UnusedCol), Cells(LastRow, UnusedCol)).Value = Range("F" & StartRow & ":F" & LastRow).Value
  Do While WorksheetFunction.CountIf(Columns(UnusedCol), "*")
    With Columns(UnusedCol)
      Set NextLetter = .Find("*")
      If Not NextLetter Is Nothing Then
        Text = NextLetter.Value
        .Replace Text, "#N/A", xlWhole
        With .SpecialCells(xlCellTypeConstants, xlErrors)
          Addr = .Address
          .Clear
          Range(Addr).EntireRow.Copy Worksheets(Text).Range("A2")
        End With
      End If
    End With
  Loop
End Sub

 

[damanirahul]

I'm guessing your client's names are not A, B, C, etc., so I am going to have to make some assuptions. I have assumed you have sheets named for the each client, so I have written the client's data to the sheet named for the client. I have also assumed that the client's sheets are always blank when you run this macro. With those assumptions in mind, give this macro a try...

Sub SplitOutData()
  Dim UnusedCol As Long, LastRow As Long, NextLetter As Range, Addr As String, Text As String
  Const StartRow As Long = 2
  LastRow = Cells(Rows.Count, "A").End(xlUp).Row
  UnusedCol = Cells.Find(What:="*", SearchOrder:=xlByColumns, _
              SearchDirection:=xlPrevious, LookIn:=xlFormulas).Column + 1
  Range(Cells(StartRow, UnusedCol), Cells(LastRow, UnusedCol)).Value = Range("F" & StartRow & ":F" & LastRow).Value
  Do While WorksheetFunction.CountIf(Columns(UnusedCol), "*")
    With Columns(UnusedCol)
      Set NextLetter = .Find("*")
      If Not NextLetter Is Nothing Then
        Text = NextLetter.Value
        .Replace Text, "#N/A", xlWhole
        With .SpecialCells(xlCellTypeConstants, xlErrors)
          Addr = .Address
          .Clear
          Range(Addr).EntireRow.Copy Worksheets(Text).Range("A2")
        End With
      End If
    End With
  Loop
End Sub

Thanks Rick Rothstein for your efforts, though it didnt served my purpose. As my question was little unclear that some of your basic assumptions went wrong. Anywaz thanks for your time n efforts..

 

[damanirahul]

Thanks..

 

[MrVillareal]

I saw in the post that your not satisfied with the answers, why not try this simple help though it was through formulas.


=IFERROR(INDEX(Data!A$2:A$12,SMALL(IF(Data!$F$2:$F$12=$A$1,ROW(Data!$A$2:$A$12)-ROW(Data!$A$2)+1),ROWS(A$4:A4))),"")

This is the data that I used.

For data sheet:

Date Script Quantity Rate Total Client
20/07/2011 abc1 12 1 12 a
21/07/2011 abc2 21 2 42 b
22/07/2011 abc3 30 3 90 c
23/07/2011 abc4 39 4 156 a
24/07/2011 abc5 48 5 240 b
25/07/2011 abc6 57 6 342 c
26/07/2011 abc7 66 7 462 a
27/07/2011 abc8 75 8 600 b
28/07/2011 abc9 84 9 756 c
29/07/2011 abc10 93 10 930 a
30/07/2011 abc11 102 11 1122 a

I prepare 3 sheets for a, b, and c. For each sheet in cell A1 I put my criteria "a" for sheet a, "b" for sheet b, "c" for sheet c. Under it(A3) are the field names:


Date Script Quantity Rate Total Client
at A4=IFERROR(INDEX(Data!A$2:A$12,SMALL(IF(Data!$F$2:$F$12=$A$1,ROW(Data!$A$2:$A$12)-ROW(Data!$A$2)+1),ROWS(A$4:A4))),"")

Used ctrl + shift + enter, copy across and down.