Data Generator V3

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

Select allOpen in new window

Regards,
Brian.

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

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

Hi Brian,

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



Thank You
EOD-V3B.xlsm

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.

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.

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.

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

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)

Select allOpen 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

Select allOpen in new window

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.

Thank You

Thanks, itjockey79.

Hi Sir,