Need help for tranfer data

sear paisan

New Member
Joined
Feb 17, 2005
Messages
7
I want tranform data from sheet1 to sheet 2

What is the code in sheet2 ? When I put data of AOT in sheet1

it will show only data of AOT in sheet2 automaticaly.

Sheet1

BUY
Date Stock Price Volume Total
25/12/2003 LOXLEY 53.50 4,000 214,572.45
06/01/2004 BCP 19.20 10,000 192,513.60
06/01/2004 EGV 11.80 5,000 59,157.83
09/01/2004 SIM 22.20 10,000 222,593.85
09/01/2004 EIC 19.80 2,000 39,705.93
12/01/2004 TT&T 5.95 10,000 59,659.16
12/01/2004 KGI 6.50 20,000 130,347.75
13/01/2004 Q-CON 19.70 4,000 79,010.79
13/01/2004 Q-CON 20.30 3,000 61,062.91
16/01/2004 KEST 69.00 10,000 691,845.75
30/01/2004 ZMICO 11.30 50,000 566,511.38
04/02/2004 ZMICO 11.70 50,000 586,564.88
04/02/2004 ZMICO 11.70 50,000 586,564.88
05/02/2004 CK 21.50 50,000 1,077,875.63
06/02/2004 CK 21.50 50,000 1,077,875.63
06/02/2004 ZMICO 12.90 60,000 776,070.45
06/02/2004 SCB-W 12.20 46,800 572,487.32
06/02/2004 SCB-W 12.20 3,200 39,144.43
06/02/2004 ZMICO 12.90 40,000 517,380.30
10/02/2004 SCB-W 12.60 43,000 543,249.32
10/02/2004 SCB-W 12.60 7,000 88,435.94
11/02/2004 SCB-W 13.20 50,000 661,765.50
12/02/2004 SCB-W 13.50 17,000 230,113.91
12/02/2004 SCB-W 13.50 3,000 40,608.34
16/02/2004 SCB-W 13.70 50,000 686,832.38
11/02/2004 SCB-W 13.20 50,000 661,765.50
24/02/2004 bay 11.90 10,000 119,318.33
24/02/2004 bay 11.80 40,000 473,262.60
01/03/2004 itd 105.00 5,000 526,404.38
11/03/2004 AOT 42.00 500 21,000.00
11/03/2004 AOT 45.75 50,000 2,293,619.06
11/03/2004 AOT 46.00 50,000 2,306,152.50
11/03/2004 AOT 48.00 10,000 481,284.00
12/03/2004 aot 47.00 50,000 2,356,286.25
12/03/2004 aot 47.50 10,000 476,270.63
02/04/2004 scib-c1 5.20 200,000 1,042,782.00
02/04/2004 scb-w 8.30 100,000 832,220.25
02/04/2004 scb-w 8.30 50,000 416,110.13
05/04/2004 kest 56.00 30,000 1,684,494.00

Sheet2


AOT


Date Price Volume Total
11/03/2004 42.00 500 21,000.00
11/03/2004 45.75 50,000 2,293,619.06
11/03/2004 46.00 50,000 2,306,152.50
11/03/2004 48.00 10,000 481,284.00
12/03/2004 47.00 50,000 2,356,286.25
12/03/2004 47.50 10,000 476,270.63

Thank You.

:oops: [/quote][/list]
 

Some videos you may like

Excel Facts

Save Often
If you start asking yourself if now is a good time to save your Excel workbook, the answer is Yes

jindon

MrExcel MVP
Joined
Aug 21, 2004
Messages
16,995
Hi

try the code,

Right click on sheet2 tab -> View Code paste the code and close the window to get back to the excel
put stock id in cell A1 of sheet2

assuming data starts from A2 on sheet1 and has header on row1

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim a(), b(), c, i As Long, ii As Long, x, y, titl
If Target.Address(0, 0) <> "A1" Or IsEmpty(Target) Then Exit Sub
If Application.CountIf(Sheets("sheet1").Range("b:b"), Target) = 0 Then Exit Sub
With Sheets("sheet1")
    ReDim a(2 To .Range("b65536").End(xlUp).Row)
    ReDim b(2 To .Range("b65536").End(xlUp).Row, 1 To 5)
    a = .Range("b2", .Range("b65536").End(xlUp)).Value
    b = .Range("a2:e" & .Range("b65536").End(xlUp).Row).Value
End With
With Sheets("sheet2")
    titl = Array("Date", "Stock", "Price", "Volume", "Total")
    .Range("a2").Resize(1, 5).Value = titl
    Application.ScreenUpdating = False
    Range("a3", "e" & .UsedRange.Rows.Count + 1).Clear
    x = .Range("a1").Value
    y = Application.CountIf(Sheets("sheet1").Range("b:b"), Target)
    If x <> "" And y > 0 Then
        ReDim c(1 To y, 1 To 5)
        For i = LBound(a) To UBound(a)
            If StrComp(x, a(i, 1), vbTextCompare) = 0 Then
                ii = ii + 1: c(ii, 1) = b(i, 1): c(ii, 2) = b(i, 2): c(ii, 3) = b(i, 3)
                c(ii, 4) = b(i, 4): c(ii, 5) = b(i, 5)
            End If
        Next
    End If
    .Range("a3").Resize(UBound(c, 1), UBound(c, 2)).Value = c
    Application.ScreenUpdating = True
    Erase a, b, c
End With
End Sub
hope this helps
jindon
 

sear paisan

New Member
Joined
Feb 17, 2005
Messages
7
code above does't work

Hello Jindon
I try your code . It return blank. Please help me again.
Here is my complete sheet.

ALL(sheet1)

BUY SELL TARGET 1 STOP LOSS SELL HOLD BUY
Status Date Stock Price Volume Total Price Total Profit Price Total Profit Price Total Profit Price Total Profit % Date Stock Volume Price Status
Income 25/12/2003 LOXLEY 53.50 4,000 214,572.45 59.00 235,368.70 20,796.25 59.00 235,368.70 20,796.25 9.69 31/12/2003 5 25/12/2003 LOXLEY 4,000 53.50 Income
Income 06/01/2004 BCP 19.20 10,000 192,513.60 19.90 198,467.68 5,954.07 19.90 198,467.68 5,954.07 3.09 09/01/2004 4 06/01/2004 BCP 10,000 19.20 Income
Income 06/01/2004 EGV 11.80 5,000 59,157.83 12.20 60,836.83 1,679.00 12.20 60,836.83 1,679.00 2.84 09/01/2004 4 06/01/2004 EGV 5,000 11.80 Income
Expence 09/01/2004 SIM 22.20 10,000 222,593.85 20.50 204,451.63 -18,142.23 20.50 204,451.63 -18,142.23 -8.15 16/01/2004 6 09/01/2004 SIM 10,000 22.20 Expence
Expence 09/01/2004 EIC 19.80 2,000 39,705.93 18.00 35,903.70 -3,802.23 18.00 35,903.70 -3,802.23 -9.58 16/01/2004 6 09/01/2004 EIC 2,000 19.80 Expence
Expence 12/01/2004 TT&T 5.95 10,000 59,659.16 5.90 58,842.18 -816.99 5.90 58,842.18 -816.99 -1.37 16/01/2004 5 12/01/2004 TT&T 10,000 5.95 Expence
Expence 12/01/2004 KGI 6.50 20,000 130,347.75 6.00 119,679.00 -10,668.75 6.00 119,679.00 -10,668.75 -8.18 16/01/2004 5 12/01/2004 KGI 20,000 6.50 Expence
Expence 13/01/2004 Q-CON 19.70 4,000 79,010.79 19.70 78,589.21 -421.58 19.70 78,589.21 -421.58 -0.53 16/01/2004 4 13/01/2004 Q-CON 4,000 19.70 Expence
Expence 13/01/2004 Q-CON 20.30 3,000 61,062.91 19.70 58,941.91 -2,121.00 19.70 58,941.91 -2,121.00 -3.47 16/01/2004 4 13/01/2004 Q-CON 3,000 20.30 Expence
Expence 16/01/2004 KEST 69.00 10,000 691,845.75 65.00 648,261.25 -43,584.50 65.00 648,261.25 -43,584.50 -6.30 20/01/2004 3 16/01/2004 KEST 10,000 69.00 Expence
Income 30/01/2004 ZMICO 11.30 50,000 566,511.38 11.40 568,475.25 1,963.88 11.40 568,475.25 1,963.88 0.35 03/02/2004 3 30/01/2004 ZMICO 50,000 11.30 Income
Income 04/02/2004 ZMICO 11.70 50,000 586,564.88 12.20 608,368.25 21,803.38 12.20 608,368.25 21,803.38 3.72 04/02/2004 1 04/02/2004 ZMICO 50,000 11.70 Income
Income 04/02/2004 ZMICO 11.70 50,000 586,564.88 12.40 618,341.50 31,776.63 12.00 598,395.00 11,830.13 13.00 648,261.25 61,696.38 12.40 618,341.50 31,776.63 5.42 11/02/2004 6 04/02/2004 ZMICO 50,000 11.70 Income
Expence 05/02/2004 CK 21.50 50,000 1,077,875.63 20.70 1,032,231.38 -45,644.25 20.70 1,032,231.38 -45,644.25 20.70 1,032,231.38 -45,644.25 -4.23 06/02/2004 2 05/02/2004 CK 50,000 21.50 Expence
Expence 06/02/2004 CK 21.50 50,000 1,077,875.63 19.90 992,338.38 -85,537.25 20.70 1,032,231.38 -45,644.25 19.90 992,338.38 -85,537.25 -7.94 06/02/2004 1 06/02/2004 CK 50,000 21.50 Expence
Expence 06/02/2004 ZMICO 12.90 60,000 776,070.45 12.40 742,009.80 -34,060.65 12.40 742,009.80 -34,060.65 -4.39 11/02/2004 4 06/02/2004 ZMICO 60,000 12.90 Expence
Expence 06/02/2004 SCB-W 12.20 46,800 572,487.32 11.30 527,425.35 -45,061.97 11.80 550,762.76 -21,724.56 11.30 527,425.35 -45,061.97 -7.87 06/02/2004 1 06/02/2004 SCB-W 46,800 12.20 Expence
Expence 06/02/2004 SCB-W 12.20 3,200 39,144.43 11.40 36,382.42 -2,762.02 11.40 36,382.42 -2,762.02 -7.06 06/02/2004 1 06/02/2004 SCB-W 3,200 12.20 Expence
Expence 06/02/2004 ZMICO 12.90 40,000 517,380.30 12.10 482,705.30 -34,675.00 12.10 482,705.30 -34,675.00 -6.70 06/02/2004 1 06/02/2004 ZMICO 40,000 12.90 Expence
Income 10/02/2004 SCB-W 12.60 43,000 543,249.32 12.80 548,927.68 5,678.37 12.80 548,927.68 5,678.37 1.05 10/02/2004 1 10/02/2004 SCB-W 43,000 12.60 Income
Expence 10/02/2004 SCB-W 12.60 7,000 88,435.94 11.90 83,077.17 -5,358.76 11.90 83,077.17 -5,358.76 -6.06 19/02/2004 8 10/02/2004 SCB-W 7,000 12.60 Expence
Expence 11/02/2004 SCB-W 13.20 50,000 661,765.50 11.90 593,408.38 -68,357.13 11.90 593,408.38 -68,357.13 -10.33 19/02/2004 7 11/02/2004 SCB-W 50,000 13.20 Expence
Expence 12/02/2004 SCB-W 13.50 17,000 230,113.91 13.50 228,886.09 -1,227.83 13.50 228,886.09 -1,227.83 -0.53 12/02/2004 1 12/02/2004 SCB-W 17,000 13.50 Expence
Expence 12/02/2004 SCB-W 13.50 3,000 40,608.34 12.90 38,596.48 -2,011.86 14.10 42,186.85 1,578.51 12.90 38,596.48 -2,011.86 -4.95 16/02/2004 3 12/02/2004 SCB-W 3,000 13.50 Expence
Expence 16/02/2004 SCB-W 13.70 50,000 686,832.38 12.90 643,274.63 -43,557.75 12.90 643,274.63 -43,557.75 -6.34 16/02/2004 1 16/02/2004 SCB-W 50,000 13.70 Expence
Expence 11/02/2004 SCB-W 13.20 50,000 661,765.50 12.50 623,328.13 -38,437.38 12.50 623,328.13 -38,437.38 -5.81 19/02/2004 7 11/02/2004 SCB-W 50,000 13.20 Expence
Expence 24/02/2004 bay 11.90 10,000 119,318.33 11.20 111,700.40 -7,617.93 12.50 124,665.63 5,347.30 11.20 111,700.40 -7,617.93 -6.38 26/02/2004 3 24/02/2004 bay 10,000 11.90 Expence
Expence 24/02/2004 bay 11.80 40,000 473,262.60 11.20 446,801.60 -26,461.00 12.50 498,662.50 25,399.90 11.20 446,801.60 -26,461.00 -5.59 26/02/2004 3 24/02/2004 bay 40,000 11.80 Expence
Expence 01/03/2004 itd 105.00 5,000 526,404.38 104.00 518,609.00 -7,795.38 Good Strategy ? 104.00 518,609.00 -7,795.38 -1.48 15/03/2004 11 01/03/2004 itd 5,000 105.00 Expence
Income 11/03/2004 AOT 42.00 500 21,000.00 44.50 22,190.48 1,190.48 44.50 22,190.48 1,190.48 5.67 11/03/2004 1 11/03/2004 AOT 500 42.00 Income
Income 11/03/2004 AOT 45.75 50,000 2,293,619.06 47.00 2,343,713.75 50,094.69 47.00 2,343,713.75 50,094.69 2.18 11/03/2004 1 11/03/2004 AOT 50,000 45.75 Income
Income 11/03/2004 AOT 46.00 50,000 2,306,152.50 47.00 2,343,713.75 37,561.25 47.00 2,343,713.75 37,561.25 1.63 11/03/2004 1 11/03/2004 AOT 50,000 46.00 Income
Expence 11/03/2004 AOT 48.00 10,000 481,284.00 45.75 456,276.19 -25,007.81 45.75 456,276.19 -25,007.81 -5.20 15/03/2004 3 11/03/2004 AOT 10,000 48.00 Expence
Expence 12/03/2004 aot 47.00 50,000 2,356,286.25 46.25 2,306,314.06 -49,972.19 46.25 2,306,314.06 -49,972.19 -2.12 12/03/2004 1 12/03/2004 aot 50,000 47.00 Expence
Expence 12/03/2004 aot 47.50 10,000 476,270.63 46.25 461,262.81 -15,007.81 46.25 461,262.81 -15,007.81 -3.15 12/03/2004 1 12/03/2004 aot 10,000 47.50 Expence
Income 02/04/2004 scib-c1 5.20 200,000 1,042,782.00 5.55 1,107,030.75 64,248.75 5.55 1,107,030.75 64,248.75 6.16 02/04/2004 1 02/04/2004 scib-c1 200,000 5.20 Income
Income 02/04/2004 scb-w 8.30 100,000 832,220.25 9.50 947,458.75 115,238.50 9.50 947,458.75 115,238.50 13.85 05/04/2004 2 02/04/2004 scb-w 100,000 8.30 Income

Header is at row 8 and row9
Data start at B10

Thank You very much
 

jindon

MrExcel MVP
Joined
Aug 21, 2004
Messages
16,995
sear paisan

send a sample file to my private email.

sent PM as well

rgds,
jindon
 

jindon

MrExcel MVP
Joined
Aug 21, 2004
Messages
16,995

ADVERTISEMENT

Hi,
paste the code onto sheet module of AOT
when you activate the sheet or change C2, it will update the contents
Code:
Private Sub Worksheet_Activate()
Dim wsAll As Worksheet, r As Range, a As Variant, b As Variant, x
Dim SearchStr As String, LastR As Long, i As Integer, ii As Integer, iii As Integer
Set wsAll = Sheets("All")
SearchStr = UCase(Me.Range("c2").Value)
With wsAll
    LastR = .Range("b65536").End(xlUp).Row
    .Range("x9:x" & LastR).Copy .Range("ay1")
    .Range("ay1", .Range("ay2").End(xlDown)).AdvancedFilter xlFilterCopy, , .Range("az1"), True
    With .Range("az2", .Range("az2").End(xlDown))
        .Name = "tbl"
        .Sort key1:=wsAll.Range("az2"), order1:=xlAscending
    End With
    .Range("ay:ay").Clear
    x = Application.CountIf(.Range("x:x"), SearchStr)
    If x = 0 Then GoTo Last
    ReDim a(10 To LastR, 1 To 26): a = .Range("b10:aa" & LastR).Value
    ReDim b(1 To x, 1 To 26)
    For i = LBound(a) To UBound(a)
        If UCase(a(i, 23)) = SearchStr Then
         ii = ii + 1
                For iii = 1 To 26
                    b(ii, iii) = a(i, iii)
               Next
            End If
    Next
End With
With Me
    .Range("a6", .Range("y65536").End(xlUp).Offset(10)).ClearContents
    .Range("a6").Resize(UBound(b, 1), UBound(b, 2)).Value = b
    .Range("c6", .Range("c65536").End(xlUp)).Delete shift:=xlShiftToLeft
End With
Last:
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim wsAll As Worksheet, r As Range, a As Variant, b As Variant, x
Dim SearchStr As String, LastR As Long, i As Integer, ii As Integer, iii As Integer
If Target.Address(0, 0) <> "C2" Or IsEmpty(Target) Then Exit Sub
Set wsAll = Sheets("All")
SearchStr = UCase(Target)
With wsAll
    LastR = .Range("b65536").End(xlUp).Row
    x = Application.CountIf(.Range("x:x"), SearchStr)
    If x = 0 Then GoTo Last
    ReDim a(10 To LastR, 1 To 26): a = .Range("b10:aa" & LastR).Value
    ReDim b(1 To x, 1 To 26)
    For i = LBound(a) To UBound(a)
        If UCase(a(i, 23)) = SearchStr Then
         ii = ii + 1
                For iii = 1 To 26
                    b(ii, iii) = a(i, iii)
               Next
            End If
    Next
End With
With Me
    .Range("a6", .Range("y65536").End(xlUp).Offset(10)).ClearContents
    .Range("a6").Resize(UBound(b, 1), UBound(b, 2)).Value = b
    .Range("c6", .Range("c65536").End(xlUp)).Delete shift:=xlShiftToLeft
End With
Last:
End Sub
rgds,
jindon
 

sear paisan

New Member
Joined
Feb 17, 2005
Messages
7
Thank You

HI
Thank You very much.. I so shime to ask you again that how to activate sheet?
I set security level to low ,paste the code ,,run macro, The clipper ( helper) still show alert.
And how to remove toggle button that I cllick from control box . It show on the sheet I can't
remove it.
I just beginner of excel 's user
Thank You very much.
rgds.
sear paisan
:oops: :oops: :oops: :oops:
 

jindon

MrExcel MVP
Joined
Aug 21, 2004
Messages
16,995

ADVERTISEMENT

Hi,
Haven't you checked your email yet?
I sent the file already.

Anyway, what you can do is:

if you have previous code somewhere then you don't need it anymore, so erase that code.

Right click on the sheet tab of AOT and View Code then paste the code there.
Close the window to get back to excel

rgds,
jindon
 

jindon

MrExcel MVP
Joined
Aug 21, 2004
Messages
16,995
Acc to your PM

change code

Code:
Private Sub Worksheet_Activate()
Dim wsAll As Worksheet, r As Range, a As Variant, b As Variant, x
Dim SearchStr As String, LastR As Long, i As Integer, ii As Integer, iii As Integer
Set wsAll = Sheets("All")
SearchStr = UCase(Me.Range("c2").Value)
With wsAll
    LastR = Me.Range("b65536").End(xlUp).Row
    x = Application.CountIf(.Range("x:x"), SearchStr)
    If x = 0 Or LastR <= 5 Then GoTo Last
    LastR = .Range("b65536").End(xlUp).Row
    ReDim a(10 To LastR, 1 To 26): a = .Range("b10:aa" & LastR).Value
    ReDim b(1 To x, 1 To 25)
    For i = LBound(a) To UBound(a)
        If UCase(a(i, 23)) = SearchStr Then
         ii = ii + 1
            For iii = 1 To 2: b(ii, iii) = a(i, iii): Next
            b(ii, 3) = a(i, 4)
            For iii = 4 To 25: b(ii, iii) = a(i, iii + 1): Next
            End If
    Next
End With
With Me
    .Range("a6", .Range("y65536").End(xlUp).Offset(10)).ClearContents
    .Range("a6").Resize(UBound(b, 1), UBound(b, 2)).Value = b
End With
Last:
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim wsAll As Worksheet, r As Range, a As Variant, b As Variant, x
Dim SearchStr As String, LastR As Long, i As Integer, ii As Integer, iii As Integer
If Target.Address(0, 0) <> "C2" Or IsEmpty(Target) Then Exit Sub
Set wsAll = Sheets("All")
SearchStr = UCase(Target)
With wsAll
    LastR = Me.Range("b65536").End(xlUp).Row
    x = Application.CountIf(.Range("x:x"), SearchStr)
    If x = 0 Or LastR <= 5 Then GoTo Last
    LastR = .Range("b65536").End(xlUp).Row
    ReDim a(10 To LastR, 1 To 26): a = .Range("b10:aa" & LastR).Value
    ReDim b(1 To x, 1 To 25)
    For i = LBound(a) To UBound(a)
        If UCase(a(i, 23)) = SearchStr Then
         ii = ii + 1
            For iii = 1 To 2: b(ii, iii) = a(i, iii): Next
            b(ii, 3) = a(i, 4)
            For iii = 4 To 25: b(ii, iii) = a(i, iii + 1): Next
            End If
    Next
End With
With Me
    .Range("a6", .Range("y65536").End(xlUp).Offset(10)).ClearContents
    .Range("a6").Resize(UBound(b, 1), UBound(b, 2)).Value = b
End With
Last:
End Sub

file sent to your email
 

Watch MrExcel Video

Forum statistics

Threads
1,127,316
Messages
5,623,958
Members
416,002
Latest member
t10k14

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
Top