Locate Word In Column & Copy Adjacent Range

wkurukul · May 26th 2012

Re: Locate Word In Column & Copy Adjacent Range

HI, Jindon
My ASX folder (Libraries->Documents->My Documents->EODData->DataClient->ASCII->ASX) has the following csv files:
ASX_20120508.csv (Tuesday)
ASX_20120509.csv (Wednesday)
ASX_20120510.csv (Thursday)
ASX_20120511.csv (Friday)
ASX_20120514.csv (Monday)
ASX_20120515.csv (Tuesday)
ASX_20120516.csv (Wednesday)
ASX_20120517.csv (Thursday)
ASX_20120518.csv (Friday)
ASX_20120521.csv (Monday)
ASX_20120522.csv (Tuesday)
ASX_20120523.csv (Wednesday)
ASX_20120524.csv (Thursday)
ASX_20120525.csv (Friday)
Next Monday (2012.05.28) I will have ASX_20120528.csv file downloaded into this ASX folder. Your code takes the most current csv file which is now ASX_20120525.csv in my ASX folder. Next Monday afternoon (End Of Day - EOD) the most current file will be ASX_20120528.csv file. Tuesday it will have another csv file with the file name ASX_20120529. I hope you are now clear with the file structure. I have run out of ways of explaining this to you further.
The column A has the stock symbols (about 4200 of them) in alphabetical order. That is why the sample csv file had only the first few stocks strating with AAA.AX and the column B in all these csv files has only the same date which is the date given in the file name (e.g. ASX_2012 05 25 without spaces). Column C/D/E/F/G has corresponding data for the stock symbol which are Open price/Highest price/Lowest price/Closing price/Volume traded. I only trade in a few stock symbols and wish to update my Master Workbook with corresponding data from daily csv file at the End Of Day.
Kind regards - wkurukul

jindon · May 26th 2012

Re: Locate Word In Column & Copy Adjacent Range

OK
This will pick up the date from the csv file name, not from col.B of each line in csv data.

Code

Sub test()
    Dim myDir As String, ws As Worksheet
    Dim fn As String, txt As String, x, temp, y
    Dim maxDate As Date, myDate, msg As String
    myDir = CreateObject("WScript.Shell").SpecialFolders("mydocuments") & _
    "\EODData\DataClient\ASCII\ASX\"
    fn = GetMostCurrentFile(myDir)
    If fn = "" Then
        MsgBox "No file found"
        Exit Sub
    End If
    myDate = GetDate(fn, ".csv")
    If myDate = "" Then
        MsgBox "Can not get date from " & fn, vbCritical
        Exit Sub
    End If
    txt = CreateObject("Scripting.FileSystemObject") _
    .OpenTextFile(fn).ReadAll
    For Each ws In Worksheets
        x = InStr(1, txt, ws.Name, 1)
        If x <> 0 Then
            temp = Mid$(txt, x)
            temp = Mid$(temp, InStr(temp, ",") + 1)
            y = Split(Split(temp, vbCrLf)(0), ",")
            With ws
                maxDate = Application.Max(.Columns(1))
                If myDate > maxDate Then
                    .Rows(3).Insert
                    With .Range("a3").Resize(, UBound(y) + 1)
                        .Value = y
                        .Resize(, 1).Value = myDate
                        .Value = .Value
                        On Error Resume Next
                        .SpecialCells(4).Value = 0
                        On Error GoTo 0
                    End With
                End If
            End With
        End If
    Next
    If Len(msg) Then MsgBox msg
End Sub
 
Function GetMostCurrentFile(myDir As String) As String
    Dim fn As String, AL As Object
    fn = Dir(myDir & "ASX_*.csv")
    If fn = "" Then Exit Function
    Set AL = CreateObject("System.Collections.ArrayList")
    Do While fn <> ""
        AL.Add fn
        fn = Dir
    Loop
    AL.Sort
    AL.Reverse
    GetMostCurrentFile = myDir & AL(0)
    Set AL = Nothing
End Function
 
Function IsSheetExists(ByVal sn As String) As Boolean
    On Error Resume Next
    IsSheetExists = Len(Sheets(sn).Name)
    On Error GoTo 0
End Function




Function GetDate(ByVal txt As String, ByVal Ext As String)
    With CreateObject("VBScript.RegExp")
        .Pattern = ".*_(\d{4})(\d{2})(\d{2})(?:(" & Ext & "))"
        If .test(txt) Then
            On Error Resume Next
            GetDate = CDate(.Replace(txt, "$1/$2/$3"))
        End If
        If Err <> 0 Then
            On Error GoTo 0
            GetDate = ""
        End If
    End With
End Function

Display More

wkurukul · May 27th 2012

Re: Locate Word In Column & Copy Adjacent Range

Hi, Jindon
Works like MAGIC!!!
You have finally done it!!! I congratulate you for this expertise.
We can now close this thread as SOLVED. I am grateful to you for helping. I have contributed in a smalll way towards the cause this website is sponsoring.
OZGrid is an extremely useful website, the best available, I would say!!!
Kind regards
wkurukul

wkurukul · May 27th 2012

Re: Locate Word In Column & Copy Adjacent Range

Hi, Jindon
YOU ARE REALLY AN EXTREMELY USEFUL MEMBER!!! Thank you very much!
Kind regards
wkurukul

wkurukul · May 27th 2012

Re: Locate Word In Column & Copy Adjacent Range [SOLVED]

SOLVED

Code

[COLOR=#0000ff]Sub[/COLOR] test() 
    [COLOR=#0000ff]Dim[/COLOR] myDir [COLOR=#0000ff]As[/COLOR] [COLOR=#0000ff]String[/COLOR], ws [COLOR=#0000ff]As[/COLOR] Worksheet 
    [COLOR=#0000ff]Dim[/COLOR] fn [COLOR=#0000ff]As[/COLOR] [COLOR=#0000ff]String[/COLOR], txt [COLOR=#0000ff]As[/COLOR] [COLOR=#0000ff]String[/COLOR], x, temp, y 
    [COLOR=#0000ff]Dim[/COLOR] maxDate [COLOR=#0000ff]As Date[/COLOR], myDate, msg [COLOR=#0000ff]As[/COLOR] [COLOR=#0000ff]String[/COLOR] 
    myDir = CreateObject("WScript.Shell").SpecialFolders("mydocuments") & _ 
    "\EODData\DataClient\ASCII\ASX\" 
    fn = GetMostCurrentFile(myDir) 
    [COLOR=#0000ff]If[/COLOR] fn = "" [COLOR=#0000ff]Then[/COLOR] 
        MsgBox "No file found" 
        Exit [COLOR=#0000ff]Sub[/COLOR] 
    [COLOR=#0000ff]End[/COLOR] [COLOR=#0000ff]If[/COLOR] 
    myDate = GetDate(fn, ".csv") 
    [COLOR=#0000ff]If[/COLOR] myDate = "" [COLOR=#0000ff]Then[/COLOR] 
        MsgBox "Can not get date from " & fn, vbCritical 
        Exit [COLOR=#0000ff]Sub[/COLOR] 
    [COLOR=#0000ff]End[/COLOR] [COLOR=#0000ff]If[/COLOR] 
    txt = CreateObject("Scripting.FileSystemObject") _ 
    .OpenTextFile(fn).ReadAll 
    [COLOR=#0000ff]For Each[/COLOR] ws [COLOR=#0000ff]In[/COLOR] Worksheets 
        x = InStr(1, txt, ws.Name, 1) 
        [COLOR=#0000ff]If[/COLOR] x <> 0 [COLOR=#0000ff]Then[/COLOR] 
            temp = Mid$(txt, x) 
            temp = Mid$(temp, InStr(temp, ",") + 1) 
            y = Split(Split(temp, vbCrLf)(0), ",") 
            [COLOR=#0000ff]With[/COLOR] ws 
                maxDate = Application.Max(.Columns(1)) 
                [COLOR=#0000ff]If[/COLOR] myDate > maxDate [COLOR=#0000ff]Then[/COLOR] 
                    .Rows(3).Insert 
                    [COLOR=#0000ff]With[/COLOR] .Range("a3").Resize(, [COLOR=#0000ff]UBound[/COLOR](y) + 1) 
                        .Value = y 
                        .Resize(, 1).Value = myDate 
                        .Value = .Value 
                        [COLOR=#0000ff]On Error Resume Next[/COLOR] 
                        .SpecialCells(4).Value = 0 
                        [COLOR=#0000ff]On Error Goto[/COLOR] 0 
                    [COLOR=#0000ff]End With[/COLOR] 
                [COLOR=#0000ff]End[/COLOR] [COLOR=#0000ff]If[/COLOR] 
            [COLOR=#0000ff]End With[/COLOR] 
        [COLOR=#0000ff]End[/COLOR] [COLOR=#0000ff]If[/COLOR] 
    [COLOR=#0000ff]Next[/COLOR] 
    [COLOR=#0000ff]If[/COLOR] Len(msg) [COLOR=#0000ff]Then[/COLOR] MsgBox msg 
[COLOR=#0000ff]End Sub[/COLOR] 
 
[COLOR=#0000ff]Function[/COLOR] GetMostCurrentFile(myDir [COLOR=#0000ff]As[/COLOR] [COLOR=#0000ff]String[/COLOR]) [COLOR=#0000ff]As[/COLOR] [COLOR=#0000ff]String[/COLOR] 
    [COLOR=#0000ff]Dim[/COLOR] fn [COLOR=#0000ff]As[/COLOR] [COLOR=#0000ff]String[/COLOR], AL [COLOR=#0000ff]As[/COLOR] [COLOR=#0000ff]Object[/COLOR] 
    fn = Dir(myDir & "ASX_*.csv") 
    [COLOR=#0000ff]If[/COLOR] fn = "" [COLOR=#0000ff]Then[/COLOR] [COLOR=#0000ff]Exit Function[/COLOR] 
    [COLOR=#0000ff]Set[/COLOR] AL = CreateObject("System.Collections.ArrayList") 
    [COLOR=#0000ff]Do[/COLOR] [COLOR=#0000ff]While[/COLOR] fn <> "" 
        AL.Add fn 
        fn = Dir 
    [COLOR=#0000ff]Loop[/COLOR] 
    AL.Sort 
    AL.Reverse 
    GetMostCurrentFile = myDir & AL(0) 
    [COLOR=#0000ff]Set[/COLOR] AL = [COLOR=#0000ff]Nothing[/COLOR] 
[COLOR=#0000ff]End Function[/COLOR] 
 
[COLOR=#0000ff]Function[/COLOR] IsSheetExists([COLOR=#0000ff]ByVal[/COLOR] sn [COLOR=#0000ff]As[/COLOR] [COLOR=#0000ff]String[/COLOR]) [COLOR=#0000ff]As[/COLOR] [COLOR=#0000ff]Boolean[/COLOR] 
    [COLOR=#0000ff]On Error Resume Next[/COLOR] 
    IsSheetExists = Len(Sheets(sn).Name) 
    [COLOR=#0000ff]On Error Goto[/COLOR] 0 
[COLOR=#0000ff]End Function[/COLOR] 
 
 
[COLOR=#0000ff]Function[/COLOR] GetDate([COLOR=#0000ff]ByVal[/COLOR] txt [COLOR=#0000ff]As[/COLOR] [COLOR=#0000ff]String[/COLOR], [COLOR=#0000ff]ByVal[/COLOR] Ext [COLOR=#0000ff]As[/COLOR] [COLOR=#0000ff]String[/COLOR]) 
    [COLOR=#0000ff]With[/COLOR] CreateObject("VBScript.RegExp") 
        .Pattern = ".*_(\d{4})(\d{2})(\d{2})(?:(" & Ext & "))" 
        [COLOR=#0000ff]If[/COLOR] .test(txt) [COLOR=#0000ff]Then[/COLOR] 
            [COLOR=#0000ff]On Error Resume Next[/COLOR] 
            GetDate = [COLOR=#0000ff]CDate[/COLOR](.Replace(txt, "$1/$2/$3")) 
        [COLOR=#0000ff]End[/COLOR] [COLOR=#0000ff]If[/COLOR] 
        [COLOR=#0000ff]If[/COLOR] Err <> 0 [COLOR=#0000ff]Then[/COLOR] 
            [COLOR=#0000ff]On Error Goto[/COLOR] 0 
            GetDate = "" 
        [COLOR=#0000ff]End[/COLOR] [COLOR=#0000ff]If[/COLOR] 
    [COLOR=#0000ff]End With[/COLOR] 
[COLOR=#0000ff]End Function[/COLOR]

Display More

wkurukul · May 27th 2012

Re: Locate Word In Column & Copy Adjacent Range [SOLVED]

Code

[COLOR=#0000ff]Sub[/COLOR] test() 
    [COLOR=#0000ff]Dim[/COLOR] myDir [COLOR=#0000ff]As[/COLOR] [COLOR=#0000ff]String[/COLOR], ws [COLOR=#0000ff]As[/COLOR] Worksheet 
    [COLOR=#0000ff]Dim[/COLOR] fn [COLOR=#0000ff]As[/COLOR] [COLOR=#0000ff]String[/COLOR], txt [COLOR=#0000ff]As[/COLOR] [COLOR=#0000ff]String[/COLOR], x, temp, y 
    [COLOR=#0000ff]Dim[/COLOR] maxDate [COLOR=#0000ff]As Date[/COLOR], myDate, msg [COLOR=#0000ff]As[/COLOR] [COLOR=#0000ff]String[/COLOR] 
    myDir = CreateObject("WScript.Shell").SpecialFolders("mydocuments") & _ 
    "\EODData\DataClient\ASCII\ASX\" 
    fn = GetMostCurrentFile(myDir) 
    [COLOR=#0000ff]If[/COLOR] fn = "" [COLOR=#0000ff]Then[/COLOR] 
        MsgBox "No file found" 
        Exit [COLOR=#0000ff]Sub[/COLOR] 
    [COLOR=#0000ff]End[/COLOR] [COLOR=#0000ff]If[/COLOR] 
    myDate = GetDate(fn, ".csv") 
    [COLOR=#0000ff]If[/COLOR] myDate = "" [COLOR=#0000ff]Then[/COLOR] 
        MsgBox "Can not get date from " & fn, vbCritical 
        Exit [COLOR=#0000ff]Sub[/COLOR] 
    [COLOR=#0000ff]End[/COLOR] [COLOR=#0000ff]If[/COLOR] 
    txt = CreateObject("Scripting.FileSystemObject") _ 
    .OpenTextFile(fn).ReadAll 
    [COLOR=#0000ff]For Each[/COLOR] ws [COLOR=#0000ff]In[/COLOR] Worksheets 
        x = InStr(1, txt, ws.Name, 1) 
        [COLOR=#0000ff]If[/COLOR] x <> 0 [COLOR=#0000ff]Then[/COLOR] 
            temp = Mid$(txt, x) 
            temp = Mid$(temp, InStr(temp, ",") + 1) 
            y = Split(Split(temp, vbCrLf)(0), ",") 
            [COLOR=#0000ff]With[/COLOR] ws 
                maxDate = Application.Max(.Columns(1)) 
                [COLOR=#0000ff]If[/COLOR] myDate > maxDate [COLOR=#0000ff]Then[/COLOR] 
                    .Rows(3).Insert 
                    [COLOR=#0000ff]With[/COLOR] .Range("a3").Resize(, [COLOR=#0000ff]UBound[/COLOR](y) + 1) 
                        .Value = y 
                        .Resize(, 1).Value = myDate 
                        .Value = .Value 
                        [COLOR=#0000ff]On Error Resume Next[/COLOR] 
                        .SpecialCells(4).Value = 0 
                        [COLOR=#0000ff]On Error Goto[/COLOR] 0 
                    [COLOR=#0000ff]End With[/COLOR] 
                [COLOR=#0000ff]End[/COLOR] [COLOR=#0000ff]If[/COLOR] 
            [COLOR=#0000ff]End With[/COLOR] 
        [COLOR=#0000ff]End[/COLOR] [COLOR=#0000ff]If[/COLOR] 
    [COLOR=#0000ff]Next[/COLOR] 
    [COLOR=#0000ff]If[/COLOR] Len(msg) [COLOR=#0000ff]Then[/COLOR] MsgBox msg 
[COLOR=#0000ff]End Sub[/COLOR] 
 
[COLOR=#0000ff]Function[/COLOR] GetMostCurrentFile(myDir [COLOR=#0000ff]As[/COLOR] [COLOR=#0000ff]String[/COLOR]) [COLOR=#0000ff]As[/COLOR] [COLOR=#0000ff]String[/COLOR] 
    [COLOR=#0000ff]Dim[/COLOR] fn [COLOR=#0000ff]As[/COLOR] [COLOR=#0000ff]String[/COLOR], AL [COLOR=#0000ff]As[/COLOR] [COLOR=#0000ff]Object[/COLOR] 
    fn = Dir(myDir & "ASX_*.csv") 
    [COLOR=#0000ff]If[/COLOR] fn = "" [COLOR=#0000ff]Then[/COLOR] [COLOR=#0000ff]Exit Function[/COLOR] 
    [COLOR=#0000ff]Set[/COLOR] AL = CreateObject("System.Collections.ArrayList") 
    [COLOR=#0000ff]Do[/COLOR] [COLOR=#0000ff]While[/COLOR] fn <> "" 
        AL.Add fn 
        fn = Dir 
    [COLOR=#0000ff]Loop[/COLOR] 
    AL.Sort 
    AL.Reverse 
    GetMostCurrentFile = myDir & AL(0) 
    [COLOR=#0000ff]Set[/COLOR] AL = [COLOR=#0000ff]Nothing[/COLOR] 
[COLOR=#0000ff]End Function[/COLOR] 
 
[COLOR=#0000ff]Function[/COLOR] IsSheetExists([COLOR=#0000ff]ByVal[/COLOR] sn [COLOR=#0000ff]As[/COLOR] [COLOR=#0000ff]String[/COLOR]) [COLOR=#0000ff]As[/COLOR] [COLOR=#0000ff]Boolean[/COLOR] 
    [COLOR=#0000ff]On Error Resume Next[/COLOR] 
    IsSheetExists = Len(Sheets(sn).Name) 
    [COLOR=#0000ff]On Error Goto[/COLOR] 0 
[COLOR=#0000ff]End Function[/COLOR] 
 
 
[COLOR=#0000ff]Function[/COLOR] GetDate([COLOR=#0000ff]ByVal[/COLOR] txt [COLOR=#0000ff]As[/COLOR] [COLOR=#0000ff]String[/COLOR], [COLOR=#0000ff]ByVal[/COLOR] Ext [COLOR=#0000ff]As[/COLOR] [COLOR=#0000ff]String[/COLOR]) 
    [COLOR=#0000ff]With[/COLOR] CreateObject("VBScript.RegExp") 
        .Pattern = ".*_(\d{4})(\d{2})(\d{2})(?:(" & Ext & "))" 
        [COLOR=#0000ff]If[/COLOR] .test(txt) [COLOR=#0000ff]Then[/COLOR] 
            [COLOR=#0000ff]On Error Resume Next[/COLOR] 
            GetDate = [COLOR=#0000ff]CDate[/COLOR](.Replace(txt, "$1/$2/$3")) 
        [COLOR=#0000ff]End[/COLOR] [COLOR=#0000ff]If[/COLOR] 
        [COLOR=#0000ff]If[/COLOR] Err <> 0 [COLOR=#0000ff]Then[/COLOR] 
            [COLOR=#0000ff]On Error Goto[/COLOR] 0 
            GetDate = "" 
        [COLOR=#0000ff]End[/COLOR] [COLOR=#0000ff]If[/COLOR] 
    [COLOR=#0000ff]End With[/COLOR] 
[COLOR=#0000ff]End Function[/COLOR]

Display More

jindon · May 27th 2012

Re: Locate Word In Column & Copy Adjacent Range

Quote from wkurukul;610443

Hi, Jindon
Thank you very much!
Kind regards
wkurukul

No worries.

Two things.

1) The code tag in Code tag won't let you edit the characters, so remove those from your posts.
2) If any bugs in code, just post back.

wkurukul · May 28th 2012

Re: Locate Word In Column & Copy Adjacent Range

Quote from jindon;610451

No worries.

Two things.

1) The code tag in Code tag won't let you edit the characters, so remove those from your posts.
2) If any bugs in code, just post back.

I have encountered this problem. Perhaps you can solve it in a jiffy! The first few lines of the first worksheet (stock symbol IVV.AX) in one of my Master Workbooks are appended below. Notice that the last update skipped all data between 23 May 12 to 25 May 12. Can you help me in sorting this out. Also the code should be able to skip any stock symbol not found in the csv data files.
Kind regards - wkurukul
[TABLE="width: 452"]

[tr]

[TD="width: 21%"][/TD]
[TD="width: 17%"][/TD]
[TD="width: 16%"][/TD]
[TD="width: 16%"][/TD]
[TD="width: 16%"][/TD]
[TD="width: 15%"][/TD]

[/tr]

[tr]

[TD="width: 21%"]Date

[/TD]
[TD="width: 17%"] Open

[/TD]
[TD="width: 16%"] High

[/TD]
[TD="width: 16%"] Low

[/TD]
[TD="width: 16%"][/TD]
[TD="width: 15%"]Volume

[/TD]

[/tr]

[tr]

[TD="width: 21%"]28-May-12

[/TD]
[TD="width: 17%"] 136.04

[/TD]
[TD="width: 16%"] 136.04

[/TD]
[TD="width: 16%"] 135.30

[/TD]
[TD="width: 16%"] 135.30

[/TD]
[TD="width: 15%"]1921

[/TD]

[/tr]

[tr]

[TD="width: 21%"]22-May-12

[/TD]
[TD="width: 17%"] 131.81

[/TD]
[TD="width: 16%"] 134.00

[/TD]
[TD="width: 16%"] 131.81

[/TD]
[TD="width: 16%"] 133.80

[/TD]
[TD="width: 15%"]16005

[/TD]

[/tr]

[tr]

[TD="width: 21%"]21-May-12

[/TD]
[TD="width: 17%"] 132.81

[/TD]
[TD="width: 16%"] 132.86

[/TD]
[TD="width: 16%"] 131.81

[/TD]
[TD="width: 16%"] 131.81

[/TD]
[TD="width: 15%"]21294

[/TD]

[/tr]

[tr]

[TD="width: 21%"]18-May-12

[/TD]
[TD="width: 17%"] 134.00

[/TD]
[TD="width: 16%"] 134.00

[/TD]
[TD="width: 16%"] 132.88

[/TD]
[TD="width: 16%"] 133.00

[/TD]
[TD="width: 15%"]13652

[/TD]

[/tr]

[tr]

[TD="width: 21%"]17-May-12

[/TD]
[TD="width: 17%"] 134.60

[/TD]
[TD="width: 16%"] 134.80

[/TD]
[TD="width: 16%"] 134.54

[/TD]
[TD="width: 16%"] 134.54

[/TD]
[TD="width: 15%"]4180

[/TD]

[/tr]

[tr]

[TD="width: 21%"]16-May-12

[/TD]
[TD="width: 17%"] 135.03

[/TD]
[TD="width: 16%"] 135.08

[/TD]
[TD="width: 16%"] 134.56

[/TD]
[TD="width: 16%"] 134.56

[/TD]
[TD="width: 15%"]9244

[/TD]

[/tr]

[tr]

[TD="width: 21%"]15-May-12

[/TD]
[TD="width: 17%"] 136.06

[/TD]
[TD="width: 16%"] 136.06

[/TD]
[TD="width: 16%"] 135.06

[/TD]
[TD="width: 16%"] 135.17

[/TD]
[TD="width: 15%"]13622

[/TD]

[/tr]

[tr]

[TD="width: 21%"]14-May-12

[/TD]
[TD="width: 17%"] 135.58

[/TD]
[TD="width: 16%"] 135.75

[/TD]
[TD="width: 16%"] 135.28

[/TD]
[TD="width: 16%"] 135.41

[/TD]
[TD="width: 15%"]6100

[/TD]

[/tr]

[tr]

[TD="width: 21%"]11-May-12

[/TD]
[TD="width: 17%"] 134.85

[/TD]
[TD="width: 16%"] 135.34

[/TD]
[TD="width: 16%"] 134.75

[/TD]
[TD="width: 16%"] 135.34

[/TD]
[TD="width: 15%"]6300

[/TD]

[/tr]

[tr]

[TD="width: 21%"]10-May-12

[/TD]
[TD="width: 17%"] 136.00

[/TD]
[TD="width: 16%"] 136.00

[/TD]
[TD="width: 16%"] 134.96

[/TD]
[TD="width: 16%"] 135.10

[/TD]
[TD="width: 15%"]13000

[/TD]

[/tr]

[tr]

[TD="width: 21%"]9-May-12

[/TD]
[TD="width: 17%"] 135.04

[/TD]
[TD="width: 16%"] 135.61

[/TD]
[TD="width: 16%"] 135.04

[/TD]
[TD="width: 16%"] 135.60

[/TD]
[TD="width: 15%"]7200

[/TD]

[/tr]

[tr]

[TD="width: 21%"]8-May-12

[/TD]
[TD="width: 17%"] 133.80

[/TD]
[TD="width: 16%"] 135.17

[/TD]
[TD="width: 16%"] 133.80

[/TD]
[TD="width: 16%"] 135.04

[/TD]
[TD="width: 15%"]29600

[/TD]

[/tr]

[tr]

[TD="width: 21%"]7-May-12

[/TD]
[TD="width: 17%"] 134.50

[/TD]
[TD="width: 16%"] 134.51

[/TD]
[TD="width: 16%"] 133.74

[/TD]
[TD="width: 16%"] 133.81

[/TD]
[TD="width: 15%"]9700

[/TD]

[/tr]

[/TABLE]

jindon · May 28th 2012

Re: Locate Word In Column & Copy Adjacent Range

I don't really understand why this happens.

Didn't you want to read only the most current file from the folder?

Or do you want to read all the csv files in the folder and update only if the date is not in col.A?

You should be very clear what you are trying to do.

wkurukul · May 28th 2012

Re: Locate Word In Column & Copy Adjacent Range

Yes. I only need the most current, but if the Master Workbook is not updated for a couple of days, I can download up to 25 May 12 and then use your code to update with the most current date. However since csv data files are already available in the ASX folder, you may be able to give me a code that will loop until most current date is updated.
The previous file I appended, I have already downloaded from YahooFinanace upto 25 May 12 and updated with EODData file which is not available from YahooFinance. So it involves several steps.
[TABLE="width: 344"]

[tr]

[td][/td]

[/tr]

[tr]

[td]

Date

[/td]

[td]

Open

[/td]

[td]

High

[/td]

[td]

Low

[/td]

[td][/td]

[td]

Volume

[/td]

[/tr]

[tr]

[TD="align: right"]28-May-12[/TD]

[td]

136.04

[/td]

[td]

136.04

[/td]

[td]

135.30

[/td]

[td]

135.30

[/td]

[TD="align: right"]1921[/TD]

[/tr]

[tr]

[TD="align: right"]25-May-12[/TD]

[td]

136.41

[/td]

[td]

136.57

[/td]

[td]

135.95

[/td]

[td]

136.26

[/td]

[TD="align: right"]2700[/TD]

[/tr]

[tr]

[TD="align: right"]24-May-12[/TD]

[td]

135.90

[/td]

[td]

136.01

[/td]

[td]

135.40

[/td]

[td]

135.50

[/td]

[TD="align: right"]2800[/TD]

[/tr]

[tr]

[TD="align: right"]23-May-12[/TD]

[td]

135.16

[/td]

[td]

135.32

[/td]

[td]

132.62

[/td]

[td]

134.73

[/td]

[TD="align: right"]9500[/TD]

[/tr]

[tr]

[TD="align: right"]22-May-12[/TD]

[td]

131.81

[/td]

[td]

134.00

[/td]

[td]

131.81

[/td]

[td]

133.80

[/td]

[TD="align: right"]16000[/TD]

[/tr]

[/TABLE]

jindon · May 28th 2012

Re: Locate Word In Column & Copy Adjacent Range

That means you need to read all the csv files to check the date in each worksheet which has matched ID and if the date is not in Col.A, update.

So basically read all the files in the folder... time consuming... if there are plenty of files...

wkurukul · May 28th 2012

Re: Locate Word In Column & Copy Adjacent Range

Quote from jindon;610569

That means you need to read all the csv files to check the date in each worksheet which has matched ID and if the date is not in Col.A, update.

So basically read all the files in the folder... time consuming... if there are plenty of files...

Never more than 5 days. I update every weekend without fail. Probably 2 - 5 days most. In fact I intend to delete old csv files every two weeks or so.
The code should look at the last update at A3 and update the with next date and the loop till most current date is reached. Hope this makes sense.
Kind regards - wkurukul

jindon · May 28th 2012

Re: Locate Word In Column & Copy Adjacent Range

1) Don't quote full post unless it is really needed. The forum doesn't like it.

2) not trested

Code

Option Explicit




Sub test()
    Dim myDir As String, ws As Worksheet, temp
    Dim fn As String, txt As String, x, y, z, myDate
    myDir = CreateObject("WScript.Shell").SpecialFolders("mydocuments") & _
    "\EODData\DataClient\ASCII\ASX\"
    fn = Dir(myDir & "ASX_*.csv")
    If fn = "" Then
        MsgBox "No file found"
        Exit Sub
    End If
    Do While fn <> ""
        myDate = GetDate(fn, ".csv")
        txt = CreateObject("Scripting.FileSystemObject") _
        .OpenTextFile(myDir & fn).ReadAll
        For Each ws In Worksheets
            x = InStr(1, txt, ws.Name, 1)
            If x <> 0 Then
                temp = Mid$(txt, x)
                temp = Mid$(temp, InStr(temp, ",") + 1)
                y = Split(Split(temp, vbCrLf)(0), ",")
                With ws
                    z = Application.Match(CLng(myDate), .Columns(1), 0)
                    If IsError(z) Then
                        .Rows(3).Insert
                        With .Range("a3").Resize(, UBound(y) + 1)
                            .Value = y
                            .Resize(, 1).Value = myDate
                            .Value = .Value
                            On Error Resume Next
                            .SpecialCells(4).Value = 0
                            On Error GoTo 0
                        End With
                    End If
                End With
            End If
        Next
        fn = Dir
    Loop
End Sub




Function IsSheetExists(ByVal sn As String) As Boolean
    On Error Resume Next
    IsSheetExists = Len(Sheets(sn).Name)
    On Error GoTo 0
End Function
 
Function GetDate(ByVal txt As String, ByVal Ext As String)
    With CreateObject("VBScript.RegExp")
        .Pattern = ".*_(\d{4})(\d{2})(\d{2})(?:(" & Ext & "))"
        If .test(txt) Then
            On Error Resume Next
            GetDate = CDate(.Replace(txt, "$1/$2/$3"))
        End If
        If Err <> 0 Then
            On Error GoTo 0
            GetDate = ""
        End If
    End With
End Function

Display More

wkurukul · May 28th 2012

Re: Locate Word In Column & Copy Adjacent Range

Works very well!!! In fact it did find a missing date of YahooFinance download and put it just above 22 May 2012
This is the Master Workbook first few lines before running the code:
[TABLE="width: 312"]

[tr]

[td][/td]

[/tr]

[tr]

[td]

Date

[/td]

[td]

Open

[/td]

[td]

High

[/td]

[td]

Low

[/td]

[td][/td]

[td]

Volume

[/td]

[/tr]

[tr]

[TD="align: right"]22-May-12
[/TD]

[td]

6.89

[/td]

[td]

6.98

[/td]

[td]

6.80

[/td]

[td]

6.87

[/td]

[TD="align: right"]5837300
[/TD]

[/tr]

[tr]

[TD="align: right"]21-May-12
[/TD]

[td]

6.67

[/td]

[td]

6.73

[/td]

[td]

6.54

[/td]

[td]

6.72

[/td]

[TD="align: right"]2434600
[/TD]

[/tr]

[tr]

[TD="align: right"]18-May-12
[/TD]

[td]

6.65

[/td]

[td]

6.65

[/td]

[td]

6.50

[/td]

[td]

6.59

[/td]

[TD="align: right"]3297100
[/TD]

[/tr]

[tr]

[TD="align: right"]17-May-12
[/TD]

[td]

6.82

[/td]

[td]

6.84

[/td]

[td]

6.72

[/td]

[td]

6.75

[/td]

[TD="align: right"]3500200
[/TD]

[/tr]

[tr]

[TD="align: right"]16-May-12
[/TD]

[td]

6.75

[/td]

[td]

6.79

[/td]

[td]

6.65

[/td]

[td]

6.71

[/td]

[TD="align: right"]3906500
[/TD]

[/tr]

[tr]

[TD="align: right"]14-May-12
[/TD]

[td]

7.05

[/td]

[td]

7.07

[/td]

[td]

6.94

[/td]

[td]

6.97

[/td]

[TD="align: right"]2865000
[/TD]

[/tr]

[tr]

[TD="align: right"]11-May-12
[/TD]

[td]

7.02

[/td]

[td]

7.03

[/td]

[td]

6.95

[/td]

[td]

7.00

[/td]

[TD="align: right"]2199600
[/TD]

[/tr]

[/TABLE]

And the following one after the update. Is there any way the 15-May-12 can be slotted in to the right place. YahooFinance gives free delayed data and they are full of errors.
Am I asking too much!!! I am happy with what you have done so far for me. If it is fun please see what can be done with the code.

[TABLE="width: 312"]

[tr]

[td][/td]

[/tr]

[tr]

[td]

Date

[/td]

[td]

Open

[/td]

[td]

High

[/td]

[td]

Low

[/td]

[td][/td]

[td]

Volume

[/td]

[/tr]

[tr]

[TD="align: right"]28-May-12[/TD]

[td]

6.76

[/td]

[td]

6.87

[/td]

[td]

6.68

[/td]

[td]

6.78

[/td]

[TD="align: right"]2354490[/TD]

[/tr]

[tr]

[TD="align: right"]25-May-12[/TD]

[td]

6.75

[/td]

[td]

6.83

[/td]

[td]

6.67

[/td]

[td]

6.70

[/td]

[TD="align: right"]3027155[/TD]

[/tr]

[tr]

[TD="align: right"]24-May-12[/TD]

[td]

6.81

[/td]

[td]

6.85

[/td]

[td]

6.74

[/td]

[td]

6.80

[/td]

[TD="align: right"]2291985[/TD]

[/tr]

[tr]

[TD="align: right"]23-May-12[/TD]

[td]

6.88

[/td]

[td]

6.93

[/td]

[td]

6.78

[/td]

[td]

6.83

[/td]

[TD="align: right"]4037925[/TD]

[/tr]

[tr]

[TD="align: right"]15-May-12[/TD]

[td]

6.97

[/td]

[td]

6.97

[/td]

[td]

6.80

[/td]

[td]

6.83

[/td]

[TD="align: right"]3299636[/TD]

[/tr]

[tr]

[TD="align: right"]22-May-12[/TD]

[td]

6.89

[/td]

[td]

6.98

[/td]

[td]

6.80

[/td]

[td]

6.87

[/td]

[TD="align: right"]5837300[/TD]

[/tr]

[tr]

[TD="align: right"]21-May-12[/TD]

[td]

6.67

[/td]

[td]

6.73

[/td]

[td]

6.54

[/td]

[td]

6.72

[/td]

[TD="align: right"]2434600[/TD]

[/tr]

[tr]

[TD="align: right"]18-May-12[/TD]

[td]

6.65

[/td]

[td]

6.65

[/td]

[td]

6.50

[/td]

[td]

6.59

[/td]

[TD="align: right"]3297100[/TD]

[/tr]

[tr]

[TD="align: right"]17-May-12[/TD]

[td]

6.82

[/td]

[td]

6.84

[/td]

[td]

6.72

[/td]

[td]

6.75

[/td]

[TD="align: right"]3500200[/TD]

[/tr]

[/TABLE]

jindon · May 28th 2012

Re: Locate Word In Column & Copy Adjacent Range

1) No more fun.
2) Insert the lines

Code

With ws
                    z = Application.Match(CLng(myDate), .Columns(1), 0)
                    If IsError(z) Then
                        .Rows(3).Insert
                        With .Range("a3").Resize(, UBound(y) + 1)
                            .Value = y
                            .Resize(, 1).Value = myDate
                            .Value = .Value
                            On Error Resume Next
                            .SpecialCells(4).Value = 0
                            On Error GoTo 0
                        End With
                    End If
                    With .Range("a3").CurrentRegion   '<---- from here
                        .Sort .Range("a1"), 2
                    End With    '<------  to here
                End With

Display More

wkurukul · May 28th 2012

Re: Locate Word In Column & Copy Adjacent Range

Code

[COLOR=#0000ff]With[/COLOR] .Range("a3").CurrentRegion [COLOR=#006400]'<---- from here[/COLOR]
        .Sort .Range("a1"), 2 
[COLOR=#0000ff]End With[/COLOR] [COLOR=#006400]'<------  to here[/COLOR]

I changed the second line to

Code

.Sort.Range ("a3"),2

because the first blank line gets deleted when your code sorted in ascending order. I have some output data to be stored in A1 row and therefore it should not get deleted.
Hope I did right.
If so, I thank you wholeheartedly for your time and effort and I would not like to tax you any more!
Kind regards
wkurukul

wkurukul · May 28th 2012

Re: Locate Word In Column & Copy Adjacent Range

No, It did not do the job. My modification is wrong!

jindon · May 28th 2012

Re: Locate Word In Column & Copy Adjacent Range

It is working with your sample workbook.

If the sheet layout is different, you should upload the real one.

wkurukul · May 30th 2012

Re: Locate Word In Column & Copy Adjacent Range

Yes, It works
Thank you again!

wkurukul · Nov 10th 2012

Re: Locate Word In Column & Copy Adjacent Range

Hi, Jindon
It is wkurukul again. Your code is working great and I am very grateful for your help with VBA expertise. I still find your above code amazing and some code lines incomprehensible due to my ignorance. I would like to ask you for small modification to the code you provided to me. How can I stop inserting data with Volume column "0" ???
[TABLE="width: 340"]

[tr]

[TD="width: 64, bgcolor: transparent"]Symbol
[/TD]
[TD="width: 70, bgcolor: transparent"]Date
[/TD]
[TD="width: 64, bgcolor: transparent"]Open
[/TD]
[TD="width: 64, bgcolor: transparent"]High
[/TD]
[TD="width: 64, bgcolor: transparent"]Low
[/TD]
[TD="width: 64, bgcolor: transparent"]Close
[/TD]
[TD="width: 64, bgcolor: transparent"]Volume
[/TD]

[/tr]

[tr]

[TD="bgcolor: transparent"]AAA.AX
[/TD]
[TD="class: xl63, bgcolor: transparent, align: right"]09-Nov-12
[/TD]
[TD="bgcolor: transparent, align: right"]50.11
[/TD]
[TD="bgcolor: transparent, align: right"]50.13
[/TD]
[TD="bgcolor: transparent, align: right"]50.11
[/TD]
[TD="bgcolor: transparent, align: right"]50.13
[/TD]
[TD="bgcolor: transparent, align: right"]27268
[/TD]

[/tr]

[tr]

[TD="bgcolor: transparent"]AAC.AX
[/TD]
[TD="class: xl63, bgcolor: transparent, align: right"]09-Nov-12
[/TD]
[TD="bgcolor: transparent, align: right"]1.355
[/TD]
[TD="bgcolor: transparent, align: right"]1.36
[/TD]
[TD="bgcolor: transparent, align: right"]1.32
[/TD]
[TD="bgcolor: transparent, align: right"]1.34
[/TD]
[TD="bgcolor: transparent, align: right"]289873
[/TD]

[/tr]

[tr]

[TD="bgcolor: transparent"]AAD.AX
[/TD]
[TD="class: xl63, bgcolor: transparent, align: right"]09-Nov-12
[/TD]
[TD="bgcolor: transparent, align: right"]1.37
[/TD]
[TD="bgcolor: transparent, align: right"]1.42
[/TD]
[TD="bgcolor: transparent, align: right"]1.365
[/TD]
[TD="bgcolor: transparent, align: right"]1.37
[/TD]
[TD="bgcolor: transparent, align: right"]1625403
[/TD]

[/tr]

[tr]

[TD="bgcolor: transparent"]AAE.AX
[/TD]
[TD="class: xl63, bgcolor: transparent, align: right"]09-Nov-12
[/TD]
[TD="bgcolor: transparent, align: right"]0.009
[/TD]
[TD="bgcolor: transparent, align: right"]0.01
[/TD]
[TD="bgcolor: transparent, align: right"]0.009
[/TD]
[TD="bgcolor: transparent, align: right"]0.01
[/TD]
[TD="bgcolor: transparent, align: right"]1397128
[/TD]

[/tr]

[tr]

[TD="bgcolor: transparent"]AAI.AX
[/TD]
[TD="class: xl63, bgcolor: transparent, align: right"]09-Nov-12
[/TD]
[TD="bgcolor: transparent, align: right"]8.4
[/TD]
[TD="bgcolor: transparent, align: right"]8.4
[/TD]
[TD="bgcolor: transparent, align: right"]8.4
[/TD]
[TD="bgcolor: transparent, align: right"]8.4
[/TD]
[TD="bgcolor: transparent, align: right"]0
[/TD]

[/tr]

[tr]

[TD="bgcolor: transparent"]AAJ.AX
[/TD]
[TD="class: xl63, bgcolor: transparent, align: right"]09-Nov-12
[/TD]
[TD="bgcolor: transparent, align: right"]0.065
[/TD]
[TD="bgcolor: transparent, align: right"]0.065
[/TD]
[TD="bgcolor: transparent, align: right"]0.065
[/TD]
[TD="bgcolor: transparent, align: right"]0.065
[/TD]
[TD="bgcolor: transparent, align: right"]146154
[/TD]

[/tr]

[tr]

[TD="bgcolor: transparent"]AAK.AX
[/TD]
[TD="class: xl63, bgcolor: transparent, align: right"]09-Nov-12
[/TD]
[TD="bgcolor: transparent, align: right"]0.002
[/TD]
[TD="bgcolor: transparent, align: right"]0.002
[/TD]
[TD="bgcolor: transparent, align: right"]0.002
[/TD]
[TD="bgcolor: transparent, align: right"]0.002
[/TD]
[TD="bgcolor: transparent, align: right"]0
[/TD]

[/tr]

[tr]

[TD="bgcolor: transparent"]AAKO.AX
[/TD]
[TD="class: xl63, bgcolor: transparent, align: right"]09-Nov-12
[/TD]
[TD="bgcolor: transparent, align: right"]0.001
[/TD]
[TD="bgcolor: transparent, align: right"]0.001
[/TD]
[TD="bgcolor: transparent, align: right"]0.001
[/TD]
[TD="bgcolor: transparent, align: right"]0.001
[/TD]
[TD="bgcolor: transparent, align: right"]0
[/TD]

[/tr]

[tr]

[TD="bgcolor: transparent"]AAL.AX
[/TD]
[TD="class: xl63, bgcolor: transparent, align: right"]09-Nov-12
[/TD]
[TD="bgcolor: transparent, align: right"]0.005
[/TD]
[TD="bgcolor: transparent, align: right"]0.005
[/TD]
[TD="bgcolor: transparent, align: right"]0.005
[/TD]
[TD="bgcolor: transparent, align: right"]0.005
[/TD]
[TD="bgcolor: transparent, align: right"]0
[/TD]

[/tr]

[/TABLE]

Please help if you can.
Kind regards
wkurukul
The current working code is shown below:

Code

Sub Macro0CopyFromCSV()
    Dim myDir As String, ws As Worksheet, temp
    Dim fn As String, txt As String, x, y, z, myDate
    myDir = CreateObject("WScript.Shell").SpecialFolders("mydocuments") & _
    "\EODData\DataClient\ASCII\ASX\"
    fn = Dir(myDir & "ASX_*.csv")
    If fn = "" Then
        MsgBox "No file found"
        Exit Sub
    End If
    Do While fn <> ""
        myDate = GetDate(fn, ".csv")
        txt = CreateObject("Scripting.FileSystemObject") _
        .OpenTextFile(myDir & fn).ReadAll
        For Each ws In Worksheets
            x = InStr(1, txt, ws.Name, 1)
            If x <> 0 Then
                temp = Mid$(txt, x)
                temp = Mid$(temp, InStr(temp, ",") + 1)
                y = Split(Split(temp, vbCrLf)(0), ",")
                With ws
                    z = Application.Match(CLng(myDate), .Columns(1), 0)
                    If IsError(z) Then
                        .Rows(3).Insert
                        With .Range("a3").Resize(, UBound(y) + 1)
                            .Value = y
                            .Resize(, 1).Value = myDate
                            .Value = .Value
                            On Error Resume Next
                            .SpecialCells(4).Value = 0
                            On Error GoTo 0
                        End With
                    End If
                End With
            End If
        Next
        fn = Dir
    Loop
End Sub
Function IsSheetExists(ByVal sn As String) As Boolean
    On Error Resume Next
    IsSheetExists = Len(Sheets(sn).Name)
    On Error GoTo 0
End Function
Function GetDate(ByVal txt As String, ByVal Ext As String)
    With CreateObject("VBScript.RegExp")
        .Pattern = ".*_(\d{4})(\d{2})(\d{2})(?:(" & Ext & "))"
        If .test(txt) Then
            On Error Resume Next
            GetDate = CDate(.Replace(txt, "$1/$2/$3"))
        End If
        If Err <> 0 Then
            On Error GoTo 0
            GetDate = ""
        End If
    End With
End Function

Display More

Locate Word In Column & Copy Adjacent Range

Participate now!

Share