?
Solved

Data Generator V3

Posted on 2012-08-15
14
Medium Priority
?
852 Views
Last Modified: 2013-12-28
Hi Experts,

Need change in VBA as it cut past data from sheet EOD to respective symbol by clicking (Ctrl+o).but problem arise when for the same date i run this macro twice or may be more it add line to symbol sheet for same date not over pasting on same date.& if it is possible in EOD sheet when i run macro then all data is disappear i want at name column data so i can link data from other sheet by using vlookup function.

pls see attached file....

Thank You
EOD-V3.xlsm
0
Comment
Question by:itjockey79
14 Comments
 
LVL 26

Expert Comment

by:redmondb
ID: 38299985
Hi, itjockey79.

Please see the code below. It assumes that there will be a header row on the EOD sheet. Please let me know if this is not always the case.
Sub process_new_data()
Dim src As Worksheet
Dim dst As Worksheet
Dim row As Range
Dim xName As Range
Dim xFind As Range
Dim xLast_Row As Long
Dim xLast_Col As Long
Dim xResponse As Long

'-- locate source data with updates
Set src = Worksheets("EOD")
xLast_Row = src.Range("A1").SpecialCells(xlLastCell).row
xLast_Col = src.Range("A1").SpecialCells(xlLastCell).Column

'-- parse each row with updated data
For Each xName In src.Range("A1:A" & xLast_Row)
    
    '-- skip header rows
    If xName <> "Name" And xName <> "" Then
    
        '-- Check than each non-blank entry has a date. (Because we need to use that Date later.)
        If xName.Offset(0, 1) = "" Then
        
            xResponse = MsgBox(xName & "'s Date is blank." & Chr(10) _
                            & """OK"" to skip this entry or ""Cancel"" to terminate run.", vbOKCancel, "Process New Data")
            If xResponse = 2 Then
                MsgBox ("Run terminating...")
                Application.StatusBar = False
                Exit Sub
            End If
        
        Else
        
            Application.StatusBar = "Updating " & xName
            
            '-- locate destination sheet
            If Not exists(xName.Value) Then
                MsgBox "No worksheet found for " & xName & ", generating one"
                Set dst = Worksheets.Add
                dst.name = xName
                dst.Range("A21") = xName
                dst.Range("A21:F21").Merge
                dst.Range("A22") = "Date"
                dst.Range("B22") = "Open"
                dst.Range("C22") = "High"
                dst.Range("D22") = "Low"
                dst.Range("E22") = "Close"
                dst.Range("F22") = "Volume"
            Else
                Set dst = Worksheets(xName.Value)
            End If
            
            '-- Check no entry exists for this date.
            Set xFind = dst.Columns(1).Find(What:=xName.Offset(0, 1), LookAt:=xlWhole)
            If xFind Is Nothing Then
                '-- move data to appropriate sheet
                '-- restrict data insertion to A23:F1500
                dst.Range("A23:F1499").Copy dst.Range("A24:F1500")
                src.Range("B" & xName.row & ":G" & xName.row).Copy dst.Range("A23")
            Else
                xResponse = MsgBox(xName & " already has data for " & Format(xName.Offset(0, 1), "dd/mm/yyyy") & "." _
                    & Chr(10) & """OK"" to skip this entry or ""Cancel"" to terminate run.", vbOKCancel, "Process New Data")
                If xResponse = 2 Then
                    MsgBox ("Run terminating...")
                    Application.StatusBar = False
                    Exit Sub
                End If
                
            End If
        
        End If
        
    End If

Next xName

src.Range("B2", src.Cells(xLast_Row, xLast_Col)).Delete xlShiftToLeft
    
Application.StatusBar = False


End Sub

Open in new window

Regards,
Brian.
0
 

Author Comment

by:itjockey79
ID: 38300010
yes in header in EOD always Name date open high low close volume want to header always be there but also name column data,as i can link rest data by vlookup & new data on same date should be over past on respective sheet,

pls provide file dont wana to spoil code while pasting in VBA screen...


Thank You
0
 
LVL 26

Expert Comment

by:redmondb
ID: 38300025
itjockey79,

Please see attached. The second "EOD" was just for testing. BTW, do you mean to have all the blank rows at the end of each sheet?

dont wana to spoil code while pasting in VBA screen...
?!

Regards,
Brian.EOD-V3B.xlsm
0
Restore individual SQL databases with ease

Veeam Explorer for Microsoft SQL Server delivers an easy-to-use, wizard-driven interface for restoring your databases from a backup. No expert SQL background required. Web interface provides a complete view of all available SQL databases to simplify the recovery of lost database

 

Author Comment

by:itjockey79
ID: 38300165
Hi Brian,

pls see attache file & its comment,& Send file in return.



Thank You
EOD-V3B.xlsm
0
 
LVL 26

Expert Comment

by:redmondb
ID: 38300232
itjockey79,

Please confirm...

(1) If an entry already exists for a company for the date then the old entry should be overwritten. (Apologies, I missed this in your original request.)

(2) On the EOD sheet, you mention "step 1 :- this shud remain after code run." I can't find any way to repeat this - no matter what data I use, the name is always left behind.

Thanks,
Brian.
0
 

Author Comment

by:itjockey79
ID: 38300520
yes step1

step 2 it is ok if names not remain bcoz if code run then formula also wiped out,so no need to remain name but you can see in my 1 attached sheet there is one more thing if any new entry comes which is not in symbol sheet then it creates new sheet for that name so pls let that process remain same.for data i used one more sheet which is BB & i had recorded macro to copy past on EOD then i run (Ctrl+o) .no step 2 4got it but be sure sir if any new entry come then create new sheet for that entry.
0
 
LVL 26

Expert Comment

by:redmondb
ID: 38300563
itjockey79,

(1) "yes step1"
Thanks.

(2) "it is ok if names not remain"
I've tried but no matter what I do the Names always remain. How are you getting rid of them?

(3) "it creates new sheet for that name"
That code is working fine for me. Is it not working for you?

(4) "if any new entry come then create new sheet for that entry"
Sure, but I'll hold off until I've got your answers to (3) and (4).

Thanks,
Brian.
0
 

Author Comment

by:itjockey79
ID: 38300673
yes create new sheet if new symbol is there is in eOD sheet

i am not talking about Name as header it is remain i am concern about name column i.e ACC LTD ,L&T  .....& so on but that requirement is not need it
   

now only just data over paste on same date & new sheet creation if new symbol is there in EOD sheet i.e current 51 symbol but if new 5 symbol added new sheet created of that name
0
 
LVL 26

Accepted Solution

by:
redmondb earned 2000 total points
ID: 38300728
itjockey79,

i am not talking about Name as header it is remain i am concern about name column i.e ACC LTD ,L&T  .....& so on but that requirement is not need it
Apologies, I still don't understand this. Please see attached (code below). If the results it gives are not correct, please manually correct the file and post it here - I'll change the code to match your changes.

 The code is...
Sub process_new_data()
Dim src As Worksheet
Dim dst As Worksheet
Dim row As Range
Dim xName As Range
Dim xFind As Range
Dim xLast_Row As Long
Dim xLast_Col As Long
Dim xResponse As Long
Dim xBB_Last_Row As Long

'-- locate source data with updates
Set src = Worksheets("EOD")
xLast_Row = src.Range("A1").SpecialCells(xlLastCell).row
xLast_Col = src.Range("A1").SpecialCells(xlLastCell).Column

'-- parse each row with updated data
For Each xName In src.Range("A1:A" & xLast_Row)
    
    '-- skip header rows
    If xName <> "Name" And xName <> "" Then
    
        '-- Check than each non-blank entry has a date. (Because we need to use that Date later.)
        If xName.Offset(0, 1) = "" Then
        
            xResponse = MsgBox(xName & "'s Date is blank." & Chr(10) _
                            & """OK"" to skip this entry or ""Cancel"" to terminate run.", vbOKCancel, "Process New Data")
            If xResponse = 2 Then
                MsgBox ("Run terminating...")
                Application.StatusBar = False
                Exit Sub
            End If
        
        Else
        
            Application.StatusBar = "Updating " & xName
            
            '-- locate destination sheet
            If Not exists(xName.Value) Then
                MsgBox "No worksheet found for " & xName & ", generating one"
                Set dst = Worksheets.Add
                dst.name = xName
                dst.Range("A21") = xName
                dst.Range("A21:F21").Merge
                dst.Range("A22") = "Date"
                dst.Range("B22") = "Open"
                dst.Range("C22") = "High"
                dst.Range("D22") = "Low"
                dst.Range("E22") = "Close"
                dst.Range("F22") = "Volume"
                
                '-- Create "BB" entry.
                xBB_Last_Row = 1 + Sheets("BB").Range("A1").SpecialCells(xlLastCell).row
                src.Range("A" & xName.row & ":G" & xName.row).Copy Sheets("BB").Range("B" & xBB_Last_Row)
                Sheets("BB").Range("C" & xBB_Last_Row).Formula = "=BDH(A" & xBB_Last_Row & ",""PX_OPEN, PX_HIGH, PX_LOW, PX_LAST, PX_VOLUME"",$N$1,$N$1,""Dts=S"",""cols=6;rows=1"")"
            Else
                Set dst = Worksheets(xName.Value)
            End If
            
            '-- Check no entry exists for this date.
            Set xFind = dst.Columns(1).Find(What:=xName.Offset(0, 1), LookAt:=xlWhole)
            If xFind Is Nothing Then
                '-- move data to appropriate sheet
                '-- restrict data insertion to A23:F1500
                dst.Range("A23:F1499").Copy dst.Range("A24:F1500")
                src.Range("B" & xName.row & ":G" & xName.row).Copy dst.Range("A23")
            Else
                src.Range("B" & xName.row & ":G" & xName.row).Copy xFind 'dst.Range("A23")
            End If
        
        End If
        
    End If

Next xName

src.Range("B2", src.Cells(xLast_Row, xLast_Col)).Delete xlShiftToLeft
    
Application.StatusBar = False

End Sub

Open in new window

Thanks,
Brian.EOD-V3C.xlsm
0
 
LVL 19

Expert Comment

by:Arno Koster
ID: 38300764
please update
            '-- move data to appropriate sheet
            '-- restrict data insertion to A23:F1500
            dst.Range("A23:F1499").Copy dst.Range("A24:F1500")
            src.Range("B" & row.row & ":G" & row.row).Copy dst.Range("A" & 23)

Open in new window

to
            '-- move data to appropriate sheet
            '-- restrict data insertion to A23:F1500
            dim result as range
            Set result = dst.Range("A:A").Find(what:=src.Range("B" & row.row))
            If result Is Nothing Then
                '-- if entry with same date cannot be found,
                '-- insert new row restrict data insertion to A23:F1500
                dst.Range("A23:F1499").Copy dst.Range("A24:F1500")
                src.Range("B" & row.row & ":G" & row.row).Copy dst.Range("A" & 23)
            Else
                '-- otherwise, overwrite the line
                src.Range("B" & row.row & ":G" & row.row).Copy dst.Range("A" & result.row)
            End If

Open in new window

0
 
LVL 26

Expert Comment

by:redmondb
ID: 38300922
Hi, akoster.

Your code appears to handle duplicate dates in a similar way to mine, but doesn't include the other functionality that the OP requested. I'm not sure what it brings to the party!

Regards,
Brian.
0
 

Author Closing Comment

by:itjockey79
ID: 38300972
Thank You
0
 
LVL 26

Expert Comment

by:redmondb
ID: 38300992
Thanks, itjockey79.
0
 
LVL 8

Expert Comment

by:Naresh Patel
ID: 39743406
Hi Sir,
Happy New Year
0

Featured Post

VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Microsoft has changed the look and feel of Azure AD and Microsoft account sign-in pages so that you will have a more unified look and feel when moving between the two interfaces.
In a use case, a user needs to close an opened report by simply pressing the Escape (Esc) key. This can be done by adding macro code in Report_KeyPress or Report_KeyDown event.
This Micro Tutorial will demonstrate in Google Sheets how to use the HYPERLINK function to create live links inside your spreadsheet.
This Micro Tutorial will demonstrate how to create pivot charts out of a data set. I also added a drop-down menu which allows to choose from different categories in the data set and the chart will automatically update.

839 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question