How to set value in the dropdown from a JSON data list?

Extracting data

• QUESTION: Thanks for your help I finally managed to make all the changes and now it's working fine. Could you please help me so that when the user clicks the button it opens the file automatically using a file location rather than "FD" File Dialog function and it choses only the files which have not been read. I'm having some problems in editing it the code as it reads the files even though they have already been updated on the server. your help is appreciated in advance. I'm attaching a copy of my latestsheet for your reference to your email ID, please have a look at it. Kind Srinivasa ANSWER: Srinivasa, 1. You could alternatively use: Sub GrabUsage() Dim fName As Variant Dim wApp As Object, wDoc As Object, WDR As Object Dim ExR As Range Dim iPos As Integer Dim sTemp As String Dim iCounter As Integer Dim sPath As String Dim sName As String Dim dDate As String Dim sTemp2 As String Dim sdate As String Call BuildAr fName = Application.GetOpenFilename If fName <> False Then Else MsgBox "No Selection has been made." Exit Sub End If 2. "It chooses only the files that not have been read". I don't understand. That's why I builded the array to compare. All files within the folder are opened, read and then after opening verified. I don't see another way, or it should be based on the names of the files. If for example in the name of the file the date is correctly mentioned you could - I suppose - eliminate the files which were read in previously from the selection. But why would you prefer that, to speed up the code? I think it won't speed up that much. 3. You say "I'm having some problems in editing it the code as it reads the files even though they have already been updated on the server." At my end here I cannot see the problem with your server. So you will need to be more specific about what you are trying to achieve. Kind ---------- FOLLOW-UP ---------- QUESTION: Thanks for your time in answering my questions. I'm sorry that I was not clear in explaining the problem 1) The reason why I was having problems with the files is that, I do get each file on a daily basis and all the Daily reports are stored in a same folder. For example if I wanted to update the data to the server I do this by selecting the destination folder which starts extracting the data from all the files instead of the required 7 files. I need to extract data only from 7 files at a time not more than 7. 2)The data extraction should start from the file by comparing it with the last file. For ex:if the data has already been extracted from 17th-24th of Aug then when I press the Extraction buttion it has to start from 25th - 31st of Aug. 3) I thought this problem could be resolved by storing the data in different column and comparing it with the last extracted file before it is actually displayed in the timestamp. I tried few ways for this but I was unsuccessful in it. Hope I'm clear in explaining you my problem. Thanks in advance for spending your precious time in answering my questions. Kind Srinivasa ANSWER: Srinivasa, In order for the program to work correctly as you want, it's important for me to understand exactly how the process occurs. I wil explain it in my own words, and please correct it where it's wrong or reply to the questions I'm asking: 1. On a server you have created a folder in which daily reports are downloaded in adocument format. The reports are put there manually by people who fill them out / or are they processed automatically by the server? If the latter is the case, isn't there in the original database data which can be accessed directly, instead of trying to get it fromdocuments? 2. On your local PC you have a spreadsheet called "PIWriteValues(latest).xls" with a button called "Diesel_Data_Extraction". This button is linked to anMacro which currently opens a dialog box by which you browse to the folder on the server. 3. In the folder on the server numerous files are stored with the following format: "Daily Ops Report dd mm yy.doc". You click on one of the files and the macro will open each and every file present in the folder on the server. It will read 2 values: a) Timestamp: this value comes from thedocument next to the cell "Beatrice Period of Report". The date is converted to the format "dd-mm-yy hh:mm:ss". b) Diesel Litres: this value comes from thedocument and is taken from the cross section "Diesel (ltrs)" and "Daily usage" (under point 9. stocks). 4. After reading the first value (Timestamp) the date is compared to the present values in "PIWriteValues(latest).xls". If it's duplicate, no further reading is done and thedocument is closed. If the value Timestamp is non-existent yet, the value of Diesel Litres is also read and written into the spreadsheet. Tag Timestamp Value Result Nigg_Diesel_Usage 11-Sep-10 00:00:00 10757 real value written 5. You also have added a column "Result" with "real value written" as value. Why? 6. What's the purpose of the column Tag "Nigg_Diesel_Usage"? In your last mail you put the following questions. See my remarks. 1) The reason why I was having problems with the files is that, I do get each file on a daily basis and all the Daily reports are stored in a same folder. For example if I wanted to update the data to the server I do this by selecting the destination folder which starts extracting the data from all the files instead of the required 7 files. I need to extract data only from 7 files at a time not more than 7. [David] Why not making a copy to a local folder on your PC from the files you really need to upload? 2)The data extraction should start from the file by comparing it with the last file. For ex:if the data has already been extracted from 17th-24th of Aug then when I press the Extraction buttion it has to start from 25th - 31st of Aug. [David] This is clear. But then again same remark. Why not use the Shift button and take files from 25th-31st of Aug by copying them to a different folder. Why is it so important to automate this? Moreover if you want this by programming you should be able to work on the file name from thedocument. Is it sure the file name of thedocument always is "Daily Ops Report dd mm yy.doc"? Is this file name in some way automatically generated by the system? 3) I thought this problem could be resolved by storing the data in different column [David] which data you want to store in a different column? and comparing it with the last extracted file before it is actually displayed in the timestamp. I tried few ways for this but I was unsuccessful in it. [David] Your remark is not clear to me. Srinivasa, 1. I think the best way forward is you try to reply to my questions and read through the process as I describe it. 2. Give me 12documents in order to be able to fully test it. 3. Tell me exactly what your final aim is. You want 2 columns: Datestamp and Diesel Litres in anspreadsheet. And then what's the next step? What are you going to do with the data? What's the final aim? 4. Why insisting on a solution which avoids double uploading. Time consuming? David ---------- FOLLOW-UP ---------- QUESTION: First of all I'm very sorry as I have not been able to explain you the problem in correct manner. The solution which I¡¯m creating is ¡°Extracting the Diesel Usage details into PI server¡±. Previously I used to open all thefiles manually then see the date in the document and diesel usage details, enter it in the 2 columns ¡°Timestamp¡± and ¡°Value¡±. Once I have entered all the details then I would press the button ¡°Start Test Writes¡± which in turn stores the details on the PI server. You can see a button called ¡°Training 2¡± that is the PI server. The main purpose of this solution which I¡¯m developing is to automate this above process which would in turn increase the efficiency of extracting the diesel usage details. The answers to your questions 1)I will be receiving the Daily reports on a daily basis to a separate mailbox and we have automated in such a way that once we receive these files to the mailbox then the files are stored automatically into a folder on our system. These files are stored in the same format as they are received i.e word doc format. 2)Instead of asking the user to select a file location, solution should select files automatically from a default or set folder where all the daily reports are stored. 3) This folder is actually stored in my system rather than on the server, from this location all the daily reports are accessed for ¡°Diesel Usage Details¡± Extraction 4) I need to start extracting the Diesel Usage Details from the next file after the last one which has already been read. Ex: if the last file extracted is 20th of Aug then when the user presses the button ¡°Diesel_Data_Extraction then the files from 21st of Aug should be read for data extraction. 5)Result column is used to display whether the details has been entered into PI server or not. If the result displayed as ¡°real value written¡± it means the data has been updated on the Training2 PI server. This happens when the user presses button ¡°Start Test Writes¡±. If the timestamp is in invalid format then it displays a message as ¡°Invalid Time¡±. 6) Nigg_Diesel_Usage is the term which we have given to an oil field it¡¯s nothing to do with any results I will send you 12 files, hope this time I¡¯m clear in explaining the problem correctly. Srinivasa I have a piece of code which extracts data from andocument but I wanted to omit the two characters in between while extracting the data.My piece of code is below. Set wDoc = wApp.Documents.Open(sPath & sName) wApp.Selection.HomeKey unit:=6 wApp.Selection.Find.ClearFormatting wApp.Selection.Find.Execute "Period of Report:" wApp.Selection.moveright unit:=2, Count:=9 wApp.Selection.moveright unit:=2, Count:=3, Extend:=1 This Extracts data from aDocument and the result is displayed as "27th August 2010". I want to display as 27 August 2010 is there any way I can neglect the 2 characters after the date. The 2 characters are in all thedocuments from which I extract the data. I do extract the data from afile and the data is found in the form of tables. The table from which I extract this particular data is in this format. Beatrice Period of Report:00:01 ¨C 24:00 2nd September 2010 Your help is appreciated in advance. Srinivasa QUESTION: I have some problem in extracting the data,the following code works fine to extract specific data from thefiles to ansheet but I want to extract the data into specific rows rather than A1 and B1. Could you also help me so that the code checks for already extracted files and doesn't extract the same data when the user presses the Button for an updated data. The following code extracts specific data, and copies into cell A1 and B1 Sub Extract_Diesel_Details() Dim wApp As Word.Application Dim wDoc As Word.Document Dim wTable As Word.Table Dim wCell As Word.Cell Dim basicPath As String Dim fName As String Dim myWS As Worksheet Dim xlCell As Range Dim lastRow As Long Dim rCount As Long Dim cCount As Long Dim RLC As Long Dim CLC As Long basicPath = ThisWorkbook.Path & Application.PathSeparator Set myWS = ThisWorkbook.Worksheets("Diesel_Details") 'clear any/all previous data on the sheet '"open" Word Set wApp = CreateObject("Word.Application") 'get first .doc file name in the folder 'with thisfile fName = Dir(basicPath & "*.doc*") Do While fName <> "" 'this puts the filename into column A to 'help separate the table data in Excel myWS.Range("A" & Rows.Count).End(xlUp).Offset(1, 0) = _ "DATE: " & fName & "" 'open thefile wApp.Documents.Open basicPath & fName Set wDoc = wApp.Documents(1) 'if there is a table in the 'Word Document, work with it If wDoc.Tables.Count > 0 Then Set wTable = wDoc.Tables(11) rCount = wTable.Rows.Count cCount = wTable.Columns.Count For RLC = 3 To rCount lastRow = myWS.Range("A" & Rows.Count).End(xlUp).Row + 0 For CLC = 3 To cCount 'if there are merged cells in the 'Word table, an error will be 'generated - ignore the error, 'but also won't process the data On Error Resume Next Set wCell = wTable.Cell(3, 3) If Err <> 0 Then Err.Clear Else If CLC = 1 Then Set xlCell = myWS.Range("D8" & lastRow) xlCell = wCell Else Set xlCell = myWS.Range("B" & lastRow) xlCell = wCell End If 'trim chr$(13) chr$(7) from end of entry in Excel If InStr(xlCell, Chr$(13)) > 0 Then xlCell = Left(xlCell, InStr(xlCell, Chr$(13)) - 1) End If End If On Error GoTo 0 Next Next Set wCell = Nothing Set wTable = Nothing End If ' end of wDoc.Tables.Count test wDoc.Close False Set wDoc = Nothing fName = Dir() ' gets next .doc* filename in the folder Loop wApp.Quit Set wApp = Nothing MsgBox "Task Completed" End Sub Your help is appreciated in advance. ANSWER: Srinivasa, Can you send me a copy of yourFile andfile to [email protected]. Then I can look at your problem. Kind FOLLOW UP: Srinivasa, I have received your files on the hotmail address and worked them through. Please use the attached code: Option Explicit Sub GrabUsage() Dim fName As String, FD As FileDialog Dim wApp As Object, wDoc As Object, WDR As Object Dim ExR As Range Dim iPos As Integer Dim sTemp As String Dim iCounter As Integer Dim sPath As String Dim sName As String Set FD = Application.FileDialog(msoFileDialogOpen) FD.Show If FD.SelectedItems.Count <> 0 Then fName = FD.SelectedItems(1) Else Exit Sub End If iCounter = 1 sTemp = REVERSETEXT(fName) iPos = InStr(REVERSETEXT(fName), "\") sPath = Left(fName, Len(fName) - iPos) & "\" sName = Dir(sPath & "*.doc") Set wApp = CreateObject("Word.Application") Do While sName <> "" Set ExR = Selection ' current location inSheet 'let's select thedoc ' openapplication and load doc ' WApp.Visible = True Set wDoc = wApp.Documents.Open(sPath & sName) 'repeat wApp.Selection.HomeKey Unit:=6 wApp.Selection.Find.ClearFormatting wApp.Selection.Find.Execute "Period of Report:" wApp.Selection.MoveRight Unit:=2, Count:=9 wApp.Selection.MoveRight Unit:=2, Count:=3, Extend:=1 Set WDR = wApp.Selection ExR(iCounter, 1) = WDR ' place atcursor ' go home and search wApp.Selection.HomeKey Unit:=6 wApp.Selection.Find.ClearFormatting wApp.Selection.Find.Execute "Stock Held" ' move cursor from find to final data item wApp.Selection.MoveDown Unit:=5, Count:=1 wApp.Selection.MoveRight Unit:=3, Count:=2 ' the miracle happens here wApp.Selection.MoveRight Unit:=2, Count:=1, Extend:=1 ' grab and put into excel Set WDR = wApp.Selection ExR(iCounter, 2) = WDR ' place in cell right ofcursor iCounter = iCounter + 1 wDoc.Close sName = Dir() Loop wApp.Quit End Sub Function REVERSETEXT(text) As String ' ' Returns its argument, reversed ' J. Walkenbach ' Dim TextLen As Integer Dim i As Integer TextLen = Len(text) For i = TextLen To 1 Step -1 REVERSETEXT = REVERSETEXT & Mid(text, i, 1) Next i End Function Also be sure to include the REVERSETEXT function ( Regarding your other point that you would like to exclude files which were already extracted: I would write an extra macro inwhere you remove automatically the duplicate lines. However in Excel 2007 there's a very neat functionality to remove duplicates from a list. So at first sight writing a macro for that seems to me superfluous. Hope this helps. Kind ---------- FOLLOW-UP ---------- QUESTION: I would also appreciate if you provide me some kind of solution which stops extracting the repeated files. Srinivasa ANSWER: Srinivasa, I have changed two things to the code: 1. I have added an extra variable for the two values you want transmitted and I have explicitly formatted to "dd-mmm-yy hh:mm:ss". Not sure if this will help. 2. The program now builds an array at start up for a selected range. You can make this flexible yourself by making a dynamic range and or build the range in the running of the program. This array is checked against each opened file. Duplicate dates therefore will not be imported anymore. Option Explicit Public sExtracted() As String Sub GrabUsage() Dim fName As String, FD As FileDialog Dim wApp As Object, wDoc As Object, WDR As Object Dim ExR As Range Dim iPos As Integer Dim sTemp As String Dim iCounter As Integer Dim sPath As String Dim sName As String Dim dDate As String Dim sTemp2 As String Call BuildAr Set FD = Application.FileDialog(msoFileDialogOpen) FD.Show If FD.SelectedItems.Count <> 0 Then fName = FD.SelectedItems(1) Else Exit Sub End If iCounter = 1 sTemp = REVERSETEXT(fName) iPos = InStr(REVERSETEXT(fName), "\") sPath = Left(fName, Len(fName) - iPos) & "\" sName = Dir(sPath & "*.doc") Set wApp = CreateObject("Word.Application") Do While sName <> "" Set ExR = Selection ' current location inSheet 'let's select thedoc ' openapplication and load doc ' WApp.Visible = True Set wDoc = wApp.Documents.Open(sPath & sName) 'repeat wApp.Selection.HomeKey Unit:=6 wApp.Selection.Find.ClearFormatting wApp.Selection.Find.Execute "Period of Report:" wApp.Selection.MoveRight Unit:=2, Count:=9 wApp.Selection.MoveRight Unit:=2, Count:=3, Extend:=1 dDate = Format(wApp.Selection, "dd-mmm-yy hh:mm:ss") If CheckDate(dDate) Then ExR(iCounter, 1) = dDate ' place atcursor ' go home and search wApp.Selection.HomeKey Unit:=6 wApp.Selection.Find.ClearFormatting wApp.Selection.Find.Execute "Stock Held" ' move cursor from find to final data item wApp.Selection.MoveDown Unit:=5, Count:=1 wApp.Selection.MoveRight Unit:=3, Count:=2 ' the miracle happens here wApp.Selection.MoveRight Unit:=2, Count:=1, Extend:=1 ' grab and put into excel sTemp2 = wApp.Selection ExR(iCounter, 2) = sTemp2 ' place in cell right ofcursor iCounter = iCounter + 1 End If wDoc.Close sName = Dir() Loop wApp.Quit End Sub Function REVERSETEXT(text) As String ' ' Returns its argument, reversed ' J. Walkenbach ' Dim TextLen As Integer Dim i As Integer TextLen = Len(text) For i = TextLen To 1 Step -1 REVERSETEXT = REVERSETEXT & Mid(text, i, 1) Next i End Function Sub BuildArray() Dim myRange As Range Dim cell As Range Dim i As Integer i = 1 For Each cell In Range("E2:E8") ReDim Preserve sExtracted(1 To i) sExtracted(i) = cell.Value i = i + 1 Next cell End Sub Function CheckDate(d As String) Dim i As Integer CheckDate = True For i = 1 To UBound(sExtracted) If sExtracted(i) = d Then CheckDate = False Exit For End If Next i End Function Kind ---------- FOLLOW-UP ---------- QUESTION: The array works fine but there is a problem with the date extracted it displays in the same old format. I have attached a spreadsheet to your email please have a look at it. Because of the different time format I'm not able to upload my data into PI server. It says invalid time. Could you please resolve this problem so that the date displays in the format which the first 3 columns displays. Srinivasa I have some problem in extracting the data,the following code works fine to extract specific data from thefiles to ansheet but I want to extract the data into specific rows rather than A1 and B1. Could you also help me so that the code checks for already extracted files and doesn't extract the same data when the user presses the Button for an updated data. The following code extracts specific data, and copies into cell A1 and B1 Sub Extract_Diesel_Details() Dim wApp As Word.Application Dim wDoc As Word.Document Dim wTable As Word.Table Dim wCell As Word.Cell Dim basicPath As String Dim fName As String Dim myWS As Worksheet Dim xlCell As Range Dim lastRow As Long Dim rCount As Long Dim cCount As Long Dim RLC As Long Dim CLC As Long basicPath = ThisWorkbook.Path & Application.PathSeparator Set myWS = ThisWorkbook.Worksheets("Diesel_Details") 'clear any/all previous data on the sheet '"open" Word Set wApp = CreateObject("Word.Application") 'get first .doc file name in the folder 'with thisfile fName = Dir(basicPath & "*.doc*") Do While fName <> "" 'this puts the filename into column A to 'help separate the table data in Excel myWS.Range("A" & Rows.Count).End(xlUp).Offset(1, 0) = _ "DATE: " & fName & "" 'open thefile wApp.Documents.Open basicPath & fName Set wDoc = wApp.Documents(1) 'if there is a table in the 'Word Document, work with it If wDoc.Tables.Count > 0 Then Set wTable = wDoc.Tables(11) rCount = wTable.Rows.Count cCount = wTable.Columns.Count For RLC = 3 To rCount lastRow = myWS.Range("A" & Rows.Count).End(xlUp).Row + 0 For CLC = 3 To cCount 'if there are merged cells in the 'Word table, an error will be 'generated - ignore the error, 'but also won't process the data On Error Resume Next Set wCell = wTable.Cell(3, 3) If Err <> 0 Then Err.Clear Else If CLC = 1 Then Set xlCell = myWS.Range("D8" & lastRow) xlCell = wCell Else Set xlCell = myWS.Range("B" & lastRow) xlCell = wCell End If 'trim chr$(13) chr$(7) from end of entry in Excel If InStr(xlCell, Chr$(13)) > 0 Then xlCell = Left(xlCell, InStr(xlCell, Chr$(13)) - 1) End If End If On Error GoTo 0 Next Next Set wCell = Nothing Set wTable = Nothing End If ' end of wDoc.Tables.Count test wDoc.Close False Set wDoc = Nothing fName = Dir() ' gets next .doc* filename in the folder Loop wApp.Quit Set wApp = Nothing MsgBox "Task Completed" End Sub Your help is appreciated in advance. QUESTION: I need your help, I am doing a simple sampling automation, In Sheet 1 is the count of Samples I needed, lets say 5, In sheet 2 is 10 set of data.. How can I extract the 5 set of data samples I needed to another spreadsheet? ANSWER: Jn I am not sure what you want by extract the 5 sets of data that you need? What is the rule that determines the ones that are needed? Do you want random samples? Do want 5 formulas on sheet 1? How often do you want the extracted data to be generated or change? It will probably be pretty easy to do what ever you like, but, there are a lot of different directions to go. ---------- FOLLOW-UP ---------- QUESTION: I'm sorry I did not provide a detailed example, so here it is... In "Sheet 1" from A1 to A2 I have 2 column named as 'Fruits',&'Sample size'. Column A1 Column A2 Fruit Sample size Apple 1 Orange 1 Mango 1 In "Sheet 2" I have 4 column Name as Fruits,Product Number,Cost,Selling price Column A1 Column A2 Column A3 Column A4 Product number Fruits Cost Selling Price 1 Orange 3 4 2 Apple 5 6 3 Orange 2 3 4 Mango 4 5 5 Apple 5 6 6 Apple 3 4 In sheet 1 is the criteria, In sheet 2 is the data I need to have a 1 sample of Apple,Orange & Mango to another spreadsheet. Column A1 Column A2 Column A3 Column A4 Product number Fruits Cost Selling Price 5 Apple 5 6 3 Orange 2 3 4 Mango 4 5 You are my last resort I really hope you can help me.

• Answer:

  Srinivasa, Thank you for the more thorough explanation. I will study tomorrow and try to offer a solution by tomorrow evening. Kind FOLLOW UP: Srinivasa, I have revised both the code on your button "Start Test Writes" as on your button "Diesel_Data_Extraction". 1. On the button "Start Test Writes" It's better to clean up a bit the code. The if statement was superfluous. I changed that. I also changed the order of the fields. I am puzzled about why you are using ranges instead of strings. 2. On the button "Diesel_Data_Extraction" / Standard Path I first changed the code referring to a standard path. Put somewhere in your spreadsheet a cell where you put in the standard path. Give it a name like "DefaultFolder". The program will look for this. If you don't do this you will get a "subscript out of range". Enter in the cell where you have your "DefaultFolder" the path like this: C:\DavidCollins\Upload 3. On the button "Diesel_Data_Extraction" / Duplicate entries The program will now go automatically to that "DefaultFolder" and start to read the data in. Before openingdocuments the program will act in the following way: a) Reading in all dates in your spreadsheet according to the column "TimeStamp". I have now made the range flexible using your code from the "Start Test Writes" procedure. The data is stored into sExtracted(). This is a 1 dimensional array = (12/09/10,13/09/10,...) b) Then I read in all file names which are in the default folder and compare them to the 1 dimensional array sExtracted(). The comparison happens in CheckDate. If no match is found the file concerned is stored into a new array called sNotExtracted(). I go through all file names in the default folder and I base myself on the date mentioned in the file name in order to verify against the array sExtracted(). Then if no more files are to be found in default folder, I have my complete array sNotExtracted(). 4. For each item in the array sNotExtracted() adocument is opened and the data is read in into your spreadsheet. Hopefully this gets you going. Button "Start Test Writes" Option Explicit Sub WriteButton_Click() Dim NoOfWrites As Integer Dim PiServer As String Dim i As Integer Dim ValueCell As Range 'Why do you use here as variable Range? Why not use a string? 'Does this have to do with the procedure "PIPutVal"? Dim PiTag As String Dim ResultCell As Range Dim macroResult As Variant Dim StartTime As Date Dim EndTime As Date Dim oContinue As Boolean Dim timestamp As String PiServer = Range("B1") i = 2 Do While Cells(i, 4).Value <> "" '*****TAG***** 'Get PI tagname "TAG" PiTag = Cells(i, 4).Value 'Get timestamp in PI format "TIMESTAMP" timestamp = Format(Cells(i, 5), "dd-mmm-yy hh:mm:ss") 'Get cell that contains value "DIESEL" Set ValueCell = Range("F" + LTrim(Str(i))) 'Get cell that contains result message "RESULT" Set ResultCell = Range("G" + LTrim(Str(i))) 'Write to PI 'MsgBox "Write " & PiTag & " - " & timestamp & " - " & ValueCell macroResult = Application.Run("PIPutVal", PiTag, ValueCell, timestamp, PiServer, ResultCell) 'Increment i i = i + 1 Loop End Sub Button "Diesel_Data_Extraction" Option Explicit Option Base 1 Public sExtracted() As String Sub GrabUsage() Dim fName As String, FD As FileDialog Dim wApp As Object, wDoc As Object, WDR As Object Dim ExR As Range Dim iPos As Integer Dim sTemp As String Dim iCounter As Integer Dim sPath As String Dim sName As String Dim dDate As String Dim sTemp2 As String Dim sdate As String Dim sNotExtracted() As String Dim i As Integer Call BuildArray_Extracted iCounter = 1 'sTemp = REVERSETEXT(fName) 'iPos = InStr(REVERSETEXT(fName), "\") 'sPath = Left(fName, Len(fName) - iPos) & "\" sPath = Range("DefaultFolder") & "\" 'Add an extra backslash sName = Dir(sPath & "*.doc") i = 1 Do While sName <> "" ReDim Preserve sNotExtracted(i) sTemp = Mid(sName, 18, 8) dDate = CDate(Left(sTemp, 2) & "/" & Mid(sTemp, 4, 2) & "/" & Mid(sTemp, 7, 2)) If CheckDate(dDate) Then sNotExtracted(i) = sPath & sName i = i + 1 End If sName = Dir() Loop Set wApp = CreateObject("Word.Application") i = 1 For i = 1 To UBound(sNotExtracted) Set ExR = Selection ' current location inSheet 'let's select thedoc ' openapplication and load doc ' WApp.Visible = True sName = sNotExtracted(i) If sName <> "" Then Set wDoc = wApp.Documents.Open(sName) 'repeat wApp.Selection.HomeKey unit:=6 wApp.Selection.Find.ClearFormatting wApp.Selection.Find.Execute "Period of Report:" wApp.Selection.moveright unit:=2, Count:=9 wApp.Selection.moveright unit:=2, Count:=3, Extend:=1 sdate = wApp.Selection sdate = Left(sdate, InStr(sdate, " ") - 3) & _ Mid(sdate, InStr(sdate, " "), Len(sdate)) 'Convert string to date dDate = CDate(sdate) If CDate(dDate) Then ExR(iCounter, 1) = sdate ' place atcursor ' go home and search wApp.Selection.HomeKey unit:=6 wApp.Selection.Find.ClearFormatting wApp.Selection.Find.Execute "Stock Held" ' move cursor from find to final data item wApp.Selection.MoveDown unit:=5, Count:=1 wApp.Selection.moveright unit:=3, Count:=2 wApp.Selection.moveright unit:=2, Count:=1, Extend:=1 ' grab and put into excel sTemp2 = wApp.Selection ExR(iCounter, 2) = sTemp2 ' place in cell right ofcursor iCounter = iCounter + 1 End If wDoc.Close End If Next i wApp.Quit End Sub Function REVERSETEXT(text) As String ' ' Returns its argument, reversed ' J. Walkenbach ' Dim TextLen As Integer Dim i As Integer TextLen = Len(text) For i = TextLen To 1 Step -1 REVERSETEXT = REVERSETEXT & Mid(text, i, 1) Next i End Function Sub BuildArray_Extracted() Dim i As Integer Dim j As Integer i = 2 j = 1 Do While Cells(i, 5).Value <> "" ReDim Preserve sExtracted(1 To j) sExtracted(j) = Cells(i, 5).Value i = i + 1 j = j + 1 Loop End Sub Function CheckDate(d As String) Dim i As Integer CheckDate = True For i = 1 To UBound(sExtracted) If sExtracted(i) = d Then CheckDate = False Exit For End If Next i End Function FOLLOW UP 2: Srinivasa, I had a look at your spreadsheet. 1. Be sure that you are in cell E9 when you push the button "Diesel_Data_Extraction". 2. Give cell H2 a name. Go for that purpose to the address box (on the left hand side just above column A) and enter "DefaultFolder". Then push Enter. 3. You can now refer to that range name in the code by: sPath = Range("DefaultFolder") & "\" 4. The way you did it, is hard coding. But that's ok as well. 5. Now, your type mismatch. You say you get a type mismatch on the line CDate(Left.... Use instead dDate = CStr(CDate(Left(sTemp, 2) & "/" & Mid(sTemp, 4, 2) & "/" & Mid(sTemp, 7, 2))) dDate expects a string. My compiler didn't have a problem with that, but yours did. So I explicitly converted it back to a string, by using CStr. Kind [......] wapp.Selection.MoveRight unit:=2, Count:=3, Extend:=1 Dim oldText As String, newText As String Dim iChar As Integer oldText = wapp.Selection iChar = InStr(1, oldText, " ") newText = Left(oldText, iChar - 3) & Mid(oldText, iChar) wDoc.Close False wapp.Quit Set wDoc = Nothing Set wapp = Nothing Application.UserControl = True ThisWorkbook.Sheets(1).Range("a1").Value = newText Srinivasa, I have received your workbook and had a look at it. I think it has to do with the way the date is coming from the system. This can be a painful and difficult thing to resolve. In a previous application I used the following formulas into resolve the issue: Make reference to one variable e.g. sTemp: sDay =worksheetfunction.DAY(sTemp) (Q) sMonth =worksheetfunction.MONTH(sTemp) (R) sYear =worksheetfunction.YEAR(sTemp) (S) Store each result in a new variable Then calculate a final variable: sFinal =worksheetfunction.IF(worksheetfunction.ISNUMBER(sTemp), _ worksheetfunction.DATE(sYear,sDay,sMonth), _ worksheetfunction.DATE(sYear,sMonth,sDay)) Maybe this method gives you idea on how to attach your specific problem. What you need to do is decompose the text string which comes back frominto the parts: Day, Month and Year. Then put them afterwards together in order to produce the date yourself. Then give the result back to Excel. Kind the code uses the reference range("A" & rowscount) - so make this cells(rowscount,1) to do the same thing - change 1 (for A) to 2 (for B) etc. As to already updated files - I think I would keep a log somewhere of the files that had been accessed and only read them if they are new files. Jn We are getting a lot closer to something I can work with. Where do you need to have the "samples"? Is that on another sheet in the same workbook? What would the output (samples) look like if all the samples sizes were not 1? What is the utility of the Product Number? Is that something you manually enter?