Populate Excel using VBA

[SimonPetherick]

Hi,

I have an excel spreadsheet (model) that contains a big table of information. Every day I populate this table with data obtained from a daily csv report. My current procedure is to open my “model” as well as the daily generated csv file – I then use a simple vlookup function to populate my table.

I’m a bit of a code novice, but is there any way that I can use code that populates my model automatically if I was to list the file name of the csv report within my model. For example:

Site Day CSV Report Name Value1 Value2 Value3
ABC 1/1/2006 report1.csv 10 20 30
XYZ 2/1/2006 report2.csv 5 6 7

Thanks.

 

[SkipVought]

Hi,

I have several applications that uses the following method:

I use ADO to query another workbook.

I use the CopyFromRecordset method to append to my Excel table. It's pretty simple.

What is the format of your .csv file?

Skip,

_{[red]Be Advised![/red] A chicken, who would drag a wagon across the road for 2 cents, is…
POULTRY in motion to PULLET for a PALTRY amount!}

 

[firefytr]

Given the complexities of your data range(s) and the formula(s) you are using, along with any other relevant data needed for a solution, I'm sure we can come up with something. Just list out everything you do exactly.

-----------
Regards,
Zack Barresse

 

[SimonPetherick]

OK, here goes...

My model (an excel spreadsheet) is called DataMonitor.xls
The format of my model is as follows:
Gas_Day,Calendar_Day,ReportName,TotalSites,Actuals,Estimates,Substitutes,MIRN1,MIRN2,....MIRN194,Total

Gas_Day = the date listed in the daily report
Calendar_Day = the date the daily report was generated
ReportName = the name of the daily csv report
TotalSites = number of sites listed within the daily report
Actuals = count of "A" from the 'type of read' column of the daily report
Estimates = count of "E" from the 'type of read' column of the daily report
Substitutes = count of "S" from the 'type of read' column of the daily report
MIRN = sites are known as MIRN's which is a 10 digit number. This column is populated with data from the 'TOTAL_DAILY_CONSUMPTION' of the daily report
Total = sum of MIRN values within my model for each Gas Day

Each day, a csv report is generated and stored in a folder (ie C:/reports). The naming of these reports are similar to
SAGAS_INTMR_ENVSA_REMCO_20060315091008.csv

The format of these reports are as follows:
MIRN,MIRN_CHECKSUM,GAS_DAY,CONSUMPTION_HR01,CONSUMPTION_HR02,....,CONSUMPTION_HR24,TOTAL_DAILY_CONSUMPTION,TYPE_OF_READ

Currently we do a manual vlookup function to populate my model with the appropriate data from the daily report. Can this be automated in any way?

Cheers.

 

[arides]

well, there is a way to automate that, and it may not be very hard. but you will probably need to work through the data manually.

here is a list of what you may do, i hope it helps:

1. the first thing would be opening the data into excel OR using ado to get the data. whatever suits you is fine. for example, you could record a macro while opening the csv and then turn the name of the archive into a variable.

with that you can automate the opening of the file

2. navigate through the data. ok, this would be the main loop on the program, since you will go through each row 'till the end, or if you are using a recordset, until EOF.

if you opened the file, u should go something like this:

dim r as range , rngWork as range

set r = Range(activecell.end(xltoright), activecell.end(xldown)) '' IMPORTANT! i assume you are positioned at the start of the source sheet; and that ALL the data is together. there is another way to do it if it's not.

for each r in rngwork

    loop

next r

if you use a recordset, it a bit simpler:

(suppose u opened succesfully the recordset)

if rs.eof and rs.bof then exit 'THERE IS NO DATA

rs.movefirst

do

loop until rs.eof

2.1 now, to navigate through the columns, you can add a new loop:

alternative 1

dim r as range , rngWork as range

set r = Range(activecell.end(xltoright), activecell.end(xldown)) '' IMPORTANT! i assume you are positioned at the start of the source sheet; and that ALL the data is together. there is another way to do it if it's not.

dim col as integer ' you can do this with another r object too
for each r in rngwork

    for col = 1 to rngwork.columns.count
          debug.print r.cells(1,col)  'use the help to 
understand the .cells property 

    next i 
  

next r

Alternative 2:

(suppose u opened succesfully the recordset)


if rs.eof and rs.bof then exit 'THERE IS NO DATA

dim col as integer

rs.movefirst

do

    for col = 1 to rs.fields.count
          debug.print rs(col)
    next i 

loop until rs.eof

3. well, i put DEBUG.PRINT just to set the example, but u should replace that with a code that writes the data to de detination range. it's not complicated, but let me know if you bump into a problem.
it could be somethin like this:

rngdestination.cells(row,column) = r.cells(1,col)

or

rngdestination.cells(row,column) = rs(col)


well that's it. hope it helps

---------------
Dogbert

Can God write a code so complex he couldn't understand?

 

[firefytr]

Hmm, I haven't tested Dogbert's suggested solutions, but if for any reason they do not lead you to where you need to go, just post the formula(s) you are entering and where you are entering them, if this range moves, offer that information as well.

-----------
Regards,
Zack Barresse

 

[SimonPetherick]

The vlookup formula that I use is:
=VLOOKUP(L7,SAGAS_INTMR_ENVSA_REMCO_20060315091008.CSV!$A$1:$AC$250,28,FALSE)

where:
L7 = the MIRN (this will never change)
SAGAS_INTMR_ENVSA_REMCO_20060315091008.CSV = the report name (this will change)
$A$1:$AC$250 = the lookup range within the report (this will never change)
28 = the row that has the TOTAL_DAILY_CONSUMPTION (this row will never change)

 

[SimonPetherick]

Basically, what I'd like to try and do is:
- Have a folder (ie C:\csvReports\) where I can place the csv reports being generated each day.
- Have a button within my excel model.
- Each time I press the button, the csv reports that are stored within that folder are processed and the data is populated into my excel model.

Can anyone please assist???? Dogbert, thanks for your response, but I'm a little confused how to implement your procedure.

 

[firefytr]

What is the file that contains the imported information? Where does this information go? Do you want to be able to choose the file from a list? Do you always want to process all files in this folder? Do you need to worry about duplicated information?

Having this always available at the click of a button is fairly easy. We can either add it to your Personal.xls file (always open and hidden with excel once created) or create an addin you have to install (only once) which can either have a custom menu (i.e. File, Edit, Help, etc) or a custom toolbar (i.e. Standard toolbar, Formatting toolbar, Reviewing toolbar, etc). Do you have a preference?

-----------
Regards,
Zack Barresse

 

[SimonPetherick]

Hi Zack.
In answering your questions....

What is the file that contains the imported information?
It is a csv file with a format:
MIRN,MIRN_CHECKSUM,GAS_DAY,CONSUMPTION_HR01,CONSUMPTION_HR02,....,CONSUMPTION_HR24,TOTAL_DAILY_CONSUMPTION,TYPE_OF_READ
And a file name similar to:
SAGAS_INTMR_ENVSA_REMCO_20060315091008.csv

Where does this information go?
Currently I am populating my model (refer to the 4th reply above for specifics such as format, etc)

Do you want to be able to choose the file from a list? or Do you always want to process all files in this folder?
I'd prefer to process all the files within the folder at once

Do you need to worry about duplicated information?
Yes, if there is a report with the same gas day as a previous report, I need to list it on a seperate line (preferably under the original report line)

Do you have a preference?
Create an addin you have to install with a custom menu would be great...

Cheers.

 

[arides]

mmm i think i understand better your need now, although i don't find other way to that but via VBA coding; since you need to run a proccess through a series of files, and you need to proccess that data:

Do you need to worry about duplicated information?
Yes, if there is a report with the same gas day as a previous report, I need to list it on a seperate line (preferably under the original report line)

.

I don't think that a VLOOKUP will help you with that, but i must confess that I tend to do things via code that can be done with excel functions...

I read my post and I agree that it is a little complicated, and without some knowledge on VBA it may get too tough. I'll try to find an app that i wrote a time ago that was a good example for that, but i don't where i got it... . Anyway, I'm not sure if that's what you want to do.

well, that's all. I'll watch for the post to see how it goes and see if I can add sthg constructive.



---------------
Dogbert

Can God write a code so complex he couldn't understand?

 

[firefytr]

Okay, let me get some of this logic straight here and you can tell me if I'm wrong or not...

Check if DataMonitor.xls is open or not; if not, open it.
Check if folder "C:\Reports" is valid or not; if valid, loop through all csv files in it.
Loop through all values in column A of each file, check if that value (Gas_Day) already exists in DataMonitor or not..
If it doesn't exist, copy that row to DataMonitor, if it does exist, do not copy it over.
Close files that were closed.
Give message box telling transfer is completed.

That about right? Let me know where I'm lacking.

-----------
Regards,
Zack Barresse

 

[arides]

okay... i don't know if u are asking simon or me, but if it was for me, basic logic would be right... some comments:

Check if DataMonitor.xls is open or not; if not, open it.

that depends: you will probably run the app from datamonitor.xls.

Check if folder "C:\Reports" is valid or not; if valid, loop through all csv files in it.

yup. that would be the first "loop".

Loop through all values in column A of each file, check if that value (Gas_Day) already exists in DataMonitor or not..
If it doesn't exist, copy that row to DataMonitor, if it does exist, do not copy it over.

also, yup. it is of course a little bit more complicated. this can be a very lenghty process so it would be wise to think carefully how to do this before coding.

Close files that were closed.

it will be more efficient if you close each file you opened after you used it. logic would be as follows:

1st loop: loop through all csv files (probably using dir function)

open csv file

Loop through all values in column A of each file...

close csv file

end 1st loop



---------------
Dogbert

Can God write a code so complex he couldn't understand?

 

[SimonPetherick]

Check if DataMonitor.xls is open or not; if not, open it.
- Nah, I'd prefer to manually open this file and have a button located within to activate the rest of the code

Check if folder "C:\Reports" is valid or not; if valid, loop through all csv files in it.
- Correct

Loop through all values in column A of each file, check if that value (Gas_Day) already exists in DataMonitor or not..
If it doesn't exist, copy that row to DataMonitor, if it does exist, do not copy it over.
- Not quite. If the Gas Day already exists in DataMonitor, add a row beneath the latest row of that Gas Day, and populate. Therefore, there may be more than one entry per gas day. It can then be sorted by 'Gas Day' and then by 'calendar day' (which is the date in which the report was generated).

Close files that were closed.
- Yep

Give message box telling transfer is completed.
- Excellent

 

[firefytr]

Okay, one more question. You said, "which is the date in which the report was generated." Do you mean you want the current date that the procedure was run put in this data?

Also note that this will be done with sample data of my own; it would be easier to test/debug with your data, but the board isn't too condusive of that (i.e. cannot upload attachments, etc), so bear with me if the generated code doesn't work the first time through.

-----------
Regards,
Zack Barresse

 

[SimonPetherick]

Thanks for your help.

 

[firefytr]

Okay, this is going to require you to modify your DataMonitor.xls file in the VBEIDE. Follow these steps; after you're done, make sure you save your data before you run anything! Follow these steps:

1. Ensure DataMonitor.xls is open
2. Press Alt + F11
3. Press Ctrl + R
4. Expand all levels of DataMonitor.xls
5. Insert 2 Standard Modules and 1 Class Module
6. Name one Standard Module: Mod_Main
7. Name the other Standard Module: Mod_Menu
8. Name the Class Module: clsBtn
To name the modules, select it and press F4, change the Name in the properties dialog box.
9. Double click 'ThisWorkbook' module, paste this code ...

Option Explicit

Private Sub Workbook_Activate()
On Error Resume Next
Application.CommandBars(MYCAPTION).Visible = True
End Sub
Private Sub Workbook_Deactivate()
On Error Resume Next
Application.CommandBars(MYCAPTION).Visible = False
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
DeleteMenu
End Sub
Private Sub Workbook_Open()
CreateMenu
End Sub

10. Double click 'Mod_Main' module and paste this code...

Option Explicit
Option Compare Text

Public ButtonEvents As Collection, ButtonEvent
Public Const NL As String = vbNewLine
Public Const DNL As String = vbNewLine & vbNewLine
Public Const TB As String = vbTab
Public Const DTB As String = vbTab & vbTab

Sub UpdateQuery()
Dim wb As Workbook, ws As Worksheet
Dim wbTEMP As Workbook, wsTEMP As Worksheet
Dim rngLook As Range, rngFind As Range, rngLoop As Range, c As Range
Dim strRptFolder As String, strFolder As String, strFile As String
Dim strPathTEMP As String, strFileTEMP As String
Dim i As Long
Dim blnWasOpenTEMP As Boolean, blnDataCopied As Boolean
strRptFolder = "C:\Reports"
strFolder = "C:\Documents and Settings\Zack Barresse\Desktop\"
strFile = "DataMonitor.xls"
If FolderExists(strRptFolder) = False Then
MsgBox "Folder """ & strRptFolder & """ does not exist!" & DNL & "Project halted.", vbCritical, "ERROR!"
GoTo ExitHere
End If
With Application
.DisplayAlerts = False
.EnableEvents = False
.ScreenUpdating = False
End With
With Application.FileSearch
.Filename = "*.csv"
.SearchSubFolders = False
.LookIn = strRptFolder
.Execute msoSortByFileName
If .FoundFiles.Count > 0 Then
If IsWbOpen(strFile) Then
Set wb = Workbooks(strFile)
Else
Set wb = Workbooks.Open(strFolder & strFile)
End If
Set ws = wb.Sheets(1) 'assumes it's the first sheet
Set rngLook = ws.Range("A:A")
For i = 1 To .FoundFiles.Count
strFileTEMP = Right(.FoundFiles(i), Len(.FoundFiles(i)) - InStrRev(.FoundFiles(i), "\"))
strPathTEMP = Left(.FoundFiles(i), Len(.FoundFiles(i)) - Len(strFileTEMP))
If IsWbOpen(strFileTEMP) Then
blnWasOpenTEMP = True
Set wbTEMP = Workbooks(strFileTEMP)
Else
blnWasOpenTEMP = False
Set wbTEMP = Workbooks.Open(strPathTEMP & strFileTEMP)
End If
Set wsTEMP = wbTEMP.Sheets(1) 'assuming it's the first sheet
Set rngLoop = wsTEMP.Range("A2", wsTEMP.Cells(wsTEMP.Rows.Count, 1).End(xlUp))
For Each c In rngLoop
Set rngFind = rngLook.Find(c.Value)
c.EntireRow.Copy
blnDataCopied = True
If Not rngFind Is Nothing Then
rngFind.Offset(1).EntireRow.Insert
rngFind.Offset(1).EntireRow.PasteSpecial xlPasteValues
Else
ws.Cells(ws.Rows.Count, 1).End(xlUp).Offset(1).EntireRow.PasteSpecial xlPasteValues
End If
Set rngFind = Nothing
Next c
If blnWasOpenTEMP = False Then
wbTEMP.Close False
End If
Set wbTEMP = Nothing
Set wsTEMP = Nothing
Next i
End If
End With
ExitHere:
With Application
.CutCopyMode = False
.DisplayAlerts = True
.EnableEvents = True
.ScreenUpdating = True
End With
If blnDataCopied = True Then
MsgBox "Data copied over.", vbInformation, "Complete!"
Else
MsgBox "No data was copied over.", vbInformation, "Complete!"
End If
End Sub

Public Function IsWbOpen(wbName As String) As Boolean
On Error Resume Next
IsWbOpen = Len(Workbooks(wbName).Name)
End Function
Public Function FolderExists(sFolder) As Boolean
FolderExists = False
If Len(Dir(sFolder, vbDirectory)) <> 0 Then FolderExists = True
End Function

11. Double click 'Mod_Menu' module and paste this code ...

Public Const MYCAPTION As String = "Update CSV Report"

Public Sub CreateMenu()
Dim Menu As CommandBar
Dim MenuItem As CommandBarButton
Dim ws As Worksheet
Dim LastRow As Long, iRow As Long
Dim i As Long, n As Long, sLen As Long
Dim MyFolder As String
Call DeleteMenu
Set ButtonEvents = New Collection
'-----------------------------------------------------------
' MAIN MENU
With Application.CommandBars
Set Menu = .Add(Name:=MYCAPTION, Position:=msoBarTop)
End With
Menu.Visible = True
Menu.Name = MYCAPTION
'-----------------------------------------------------------
' MENU ITEMS
Set MenuItem = Menu.Controls.Add(msoControlButton, temporary:=False)
MenuItem.Caption = MYCAPTION
MenuItem.FaceId = 566
MenuItem.Style = msoButtonIconAndCaption
Set ButtonEvent = New clsBtn
Set ButtonEvent.btnClick = MenuItem
ButtonEvents.Add ButtonEvent
'-----
Set MenuItem = Menu.Controls.Add(msoControlButton, temporary:=False)
MenuItem.Caption = "Info"
MenuItem.FaceId = 1954
MenuItem.Style = msoButtonIconAndCaption
Set ButtonEvent = New clsBtn
Set ButtonEvent.btnClick = MenuItem
ButtonEvents.Add ButtonEvent
'-----
'check for any values
If Menu.Controls.Count = 0 Then
Set MenuItem = Menu.Controls.Add(msoControlButton, temporary:=False)
MenuItem.Caption = "<< Error >>"
End If
'-----------------------------------------------------------
Set Menu = Nothing
Set MenuItem = Nothing
End Sub
Public Sub DeleteMenu()
On Error Resume Next
Application.CommandBars(MYCAPTION).Delete
End Sub

12. Double click 'clsBtn' class module and paste this code...

Option Explicit

Public WithEvents btnClick As CommandBarButton

Private Sub btnClick_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)
Dim Msg As VbMsgBoxResult
Select Case Ctrl.Caption
'-----------------------------------------------------------
Case MYCAPTION
Msg = MsgBox("Update CSV Report now?", vbQuestion + vbYesNo, "Process?")
If Msg <> vbYes Then Exit Sub
Call UpdateQuery
'-------------------------------------------------------------------
Case "Info"
MsgBox "This addin designed and developed" & NL & "by Zack Barresse at Tek-Tips.com." & DNL & _
"For email support, email:" & NL & "temp@temp.com." & DNL & "April 2006"
'-------------------------------------------------------------- End Select
End Sub


That should be it. Save your work, maybe even run in a test workbook. Make sure you change the file locations to what you have locally. The 'strFolder' variable is where I placed my test data (DataMonitor.xls) file. Running the CreateMenu will create you a toolbar. It will be invisible if another workbook is activated and visible when DataMonitor.xls is activated again. The toolbar defaults to the top menu bar by default, this can be changed to any side or even floating if you like.

Let me know if you have any questions. Not sure if this is going to work for you right off the bat, but we can tweak it as need be.

HTH

-----------
Regards,
Zack Barresse

 

[firefytr]

Well, I don't know if you got my message or not so I'll post the code here. Some slight changes to the Mod_Main module. Replace all the code with this ...



Option Explicit
Option Compare Text

Public ButtonEvents As Collection, ButtonEvent
Public Const NL As String = vbNewLine
Public Const DNL As String = vbNewLine & vbNewLine
Public Const TB As String = vbTab
Public Const DTB As String = vbTab & vbTab

Sub UpdateQuery()
Dim wb As Workbook, ws As Worksheet
Dim wbTEMP As Workbook, wsTEMP As Worksheet
Dim rngLook As Range, rngFind As Range, rngLoop As Range, c As Range, r As Range, x As Range
Dim rngMIRNLook As Range, rngMIRNFind As Range, rngMIRNLoop As Range, rngMIRN As Range
Dim strRptFolder As String, strFolder As String, strFile As String
Dim strPathTEMP As String, strFileTEMP As String, strDate As String
Dim i As Long, lngMIRN As Long, fDate As Date, iRow As Long, iMIRN As Long
Dim blnWasOpenTEMP As Boolean, blnDataCopied As Boolean
strRptFolder = "C:\Reports"
strFolder = "C:\"
strFile = "Data_Monitor_2006_test.xls"
If FolderExists(strRptFolder) = False Then
MsgBox "Folder """ & strRptFolder & """ does not exist!" & DNL & "Project halted.", vbCritical, "ERROR!"
GoTo ExitHere
End If
With Application
.DisplayAlerts = False
.EnableEvents = False
.ScreenUpdating = False
End With
With Application.FileSearch
.fileName = "*.csv"
.SearchSubFolders = False
.LookIn = strRptFolder
.Execute msoSortByFileName
If .FoundFiles.Count > 0 Then
If IsWbOpen(strFile) Then
Set wb = Workbooks(strFile)
Else
Set wb = Workbooks.Open(strFolder & strFile)
End If
Set ws = wb.Sheets(1) 'assumes it's the first sheet
Set rngLook = ws.Range("A:A")
For i = 1 To .FoundFiles.Count
If Right(.FoundFiles(i), 3) <> "csv" Then GoTo SkipWbTEMP
strFileTEMP = Right(.FoundFiles(i), Len(.FoundFiles(i)) - InStrRev(.FoundFiles(i), "\"))
strPathTEMP = Left(.FoundFiles(i), Len(.FoundFiles(i)) - Len(strFileTEMP))
strDate = CStr(Mid(strFileTEMP, InStrRev(strFileTEMP, "_") + 1, 8))
If IsWbOpen(strFileTEMP) Then
blnWasOpenTEMP = True
Set wbTEMP = Workbooks(strFileTEMP)
Else
blnWasOpenTEMP = False
Set wbTEMP = Workbooks.Open(strPathTEMP & strFileTEMP)
End If
Set wsTEMP = wbTEMP.Sheets(1) 'assuming it's the first sheet
' Set rngLoop = wsTEMP.Range("C2", wsTEMP.Cells(wsTEMP.Rows.Count, 3).End(xlUp))
' For Each c In rngLoop
Set c = wsTEMP.Range("C2")
Set rngFind = rngLook.Find(c.Value)
blnDataCopied = True
wb.Activate
If rngFind Is Nothing Then
iRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row + 1
Else
iRow = rngFind.Row
End If
Set x = ws.Cells(iRow, 1)
fDate = DateSerial(CLng(Left(strDate, 4)), _
CLng(Mid(strDate, 5, 2)), CLng(Right(strDate, 2)))
Set r = wsTEMP.Cells(1, wsTEMP.Columns.Count).End(xlToLeft).Offset(0, -2)
lngMIRN = CLng(Right(r.Value, 2))
'// New Row of data
If Not rngFind Is Nothing Then
x.EntireRow.Insert
Set x = x.Offset(-1)
Debug.Print x.Row
End If
'// Gas Day value
x.Value = c.Value
x.NumberFormat = "dd-mmm-yy"
'// Calendar Day value (from filename)
x.Offset(, 1).Value = fDate
x.Offset(, 1).NumberFormat = "dd-mmm-yy"
'// Filename to Remco
x.Offset(, 5).Value = strFileTEMP
'// Total MIRN's
x.Offset(, 6).Value = wsTEMP.Cells(wsTEMP.Rows.Count, 1).End(xlUp).Row - 1
'// Enter as Original or Latest file
' If x.Row = 33 Then Stop
If rngFind Is Nothing Then x.Offset(, 2).Value = "O"
If Not rngFind Is Nothing Then x.Offset(, 3).Value = "L"
'// Total of Type_Of_Read A
x.Offset(, 7).Value = WorksheetFunction.CountIf(wsTEMP.Cells(1, wsTEMP.Columns.Count).End(xlToLeft).EntireColumn, "A")
'// Total of Type_Of_Read E
x.Offset(, 8).Value = WorksheetFunction.CountIf(wsTEMP.Cells(1, wsTEMP.Columns.Count).End(xlToLeft).EntireColumn, "E")
'// Total of Type_Of_Read S
x.Offset(, 9).Value = WorksheetFunction.CountIf(wsTEMP.Cells(1, wsTEMP.Columns.Count).End(xlToLeft).EntireColumn, "S")
Set rngFind = Nothing
Set rngMIRNLoop = wsTEMP.Range("A2", wsTEMP.Cells(wsTEMP.Rows.Count, 1).End(xlUp))
Set rngMIRNLook = ws.Range("K2", ws.Cells(2, ws.Columns.Count).End(xlToLeft).Offset(0, -1))
For Each rngMIRN In rngMIRNLoop
Set rngMIRNFind = rngMIRNLook.Find(rngMIRN.Value)
If Not rngMIRNFind Is Nothing Then
Debug.Print WorksheetFunction.Sum(wsTEMP.Range("D" & rngMIRN.Row & ":AB" & rngMIRN.Row))
iMIRN = WorksheetFunction.Sum(wsTEMP.Range("D" & rngMIRN.Row & ":AB" & rngMIRN.Row))
ws.Cells(iRow, rngMIRNFind.Column).Value = iMIRN
End If
Next rngMIRN
If Len(ws.Range("GP" & x.Row).Value) = 0 Then ws.Range("GP" & x.Row).Value = 0
ws.Range("A" & x.Row & ":J" & x.Row).HorizontalAlignment = xlCenter
ws.Range("GQ" & x.Row).Formula = "=SUM(K" & x.Row & ":GP" & x.Row & ")/1000000"
If blnWasOpenTEMP = False Then
wbTEMP.Close False
End If
Set wbTEMP = Nothing
Set wsTEMP = Nothing
SkipWbTEMP:
Next i
End If
End With
With ws.Range("A5", ws.Cells(ws.Cells(ws.Rows.Count, 1).End(xlUp).Row, ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column))
.Sort Key1:=ws.Range("A5"), Order1:=xlAscending, Key2:=ws.Range("F5"), Order2:=xlAscending, Header:=xlNo
End With
ExitHere:
With Application
.CutCopyMode = False
.DisplayAlerts = True
.EnableEvents = True
.ScreenUpdating = True
End With
If blnDataCopied = True Then
MsgBox "Data copied over.", vbInformation, "Complete!"
Else
MsgBox "No data was copied over.", vbInformation, "Complete!"
End If
End Sub

Public Function IsWbOpen(wbName As String) As Boolean
On Error Resume Next
IsWbOpen = Len(Workbooks(wbName).Name)
End Function
Public Function FolderExists(sFolder) As Boolean
FolderExists = False
If Len(Dir(sFolder, vbDirectory)) <> 0 Then FolderExists = True
End Function




Let us know if this helps at all.

-----------
Regards,
Zack Barresse

 

[firefytr]

Still can't message you back for some reason. Made a few changes here...

1) Added a new standard module named "Mod_Functions" which I took out the two functions from "Mod_Main" and put them in there; I also added another function ...

Public Function IsWbOpen(wbName As String) As Boolean
    On Error Resume Next
    IsWbOpen = Len(Workbooks(wbName).Name)
End Function

Public Function FolderExists(sFolder) As Boolean
    FolderExists = False
    If Len(Dir(sFolder, vbDirectory)) <> 0 Then FolderExists = True
End Function

Function ColLet(iCol As Long) As String
    Dim strAddy As String
    If ActiveWorkbook Is Nothing Then
        ColLet = "K"
        Exit Function
    End If
    strAddy = ActiveSheet.Cells(1, iCol).Address(0, 0)
    ColLet = Left(strAddy, Len(strAddy) - 1)
End Function

There were a couple of minor changes to the "Mod_Main" code. Here is the full code. I *think* it returns the values you wanted. Check the values though.

Option Explicit
Option Compare Text

Public ButtonEvents As Collection, ButtonEvent
Public Const NL As String = vbNewLine
Public Const DNL As String = vbNewLine & vbNewLine
Public Const TB As String = vbTab
Public Const DTB As String = vbTab & vbTab

Sub UpdateQuery()
    Dim wb As Workbook, ws As Worksheet
    Dim wbTEMP As Workbook, wsTEMP As Worksheet
    Dim rngLook As Range, rngFind As Range, c As Range, r As Range, x As Range
    Dim rngMIRNLoop As Range, rngMIRN As Range
    Dim strRptFolder As String, strFolder As String, strFile As String
    Dim strPathTEMP As String, strFileTEMP As String, strDate As String
    Dim i As Long, lngMIRN As Long, fDate As Date, iRow As Long, iMIRN As Variant
    Dim blnWasOpenTEMP As Boolean, blnDataCopied As Boolean
    strRptFolder = "C:\Reports"
    strFolder = "C:\"
    strFile = "Data_Monitor_2006_test.xls"
    If FolderExists(strRptFolder) = False Then
        MsgBox "Folder """ & strRptFolder & """ does not exist!" & DNL & "Project halted.", vbCritical, "ERROR!"
        GoTo ExitHere
    End If
    With Application
        .DisplayAlerts = False
        .EnableEvents = False
        .ScreenUpdating = False
    End With
    With Application.FileSearch
        .fileName = "*.csv"
        .SearchSubFolders = False
        .LookIn = strRptFolder
        .Execute msoSortByFileName
        If .FoundFiles.Count > 0 Then
            If IsWbOpen(strFile) Then
                Set wb = Workbooks(strFile)
            Else
                Set wb = Workbooks.Open(strFolder & strFile)
            End If
            Set ws = wb.Sheets(1) 'assumes it's the first sheet
            Set rngLook = ws.Range("A:A")
            For i = 1 To .FoundFiles.Count
                Application.StatusBar = Format(i / .FoundFiles.Count, "Percent") & " complete.."
                If Right(.FoundFiles(i), 3) <> "csv" Then GoTo SkipWbTEMP
                strFileTEMP = Right(.FoundFiles(i), Len(.FoundFiles(i)) - InStrRev(.FoundFiles(i), "\"))
                strPathTEMP = Left(.FoundFiles(i), Len(.FoundFiles(i)) - Len(strFileTEMP))
                strDate = CStr(Mid(strFileTEMP, InStrRev(strFileTEMP, "_") + 1, 8))
                If IsWbOpen(strFileTEMP) Then
                    blnWasOpenTEMP = True
                    Set wbTEMP = Workbooks(strFileTEMP)
                Else
                    blnWasOpenTEMP = False
                    Set wbTEMP = Workbooks.Open(strPathTEMP & strFileTEMP)
                End If
                Set wsTEMP = wbTEMP.Sheets(1) 'assuming it's the first sheet
                Set c = wsTEMP.Range("C2")
                Set rngFind = rngLook.Find(c.Value)
                blnDataCopied = True
                wb.Activate
                If rngFind Is Nothing Then
                    iRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row + 1
                Else
                    iRow = rngFind.Row
                End If
                Set x = ws.Cells(iRow, 1)
                fDate = DateSerial(CLng(Left(strDate, 4)), _
                CLng(Mid(strDate, 5, 2)), CLng(Right(strDate, 2)))
                Set r = wsTEMP.Cells(1, wsTEMP.Columns.Count).End(xlToLeft).Offset(0, -2)
                lngMIRN = CLng(Right(r.Value, 2))
                '// New Row of data
                If Not rngFind Is Nothing Then
                    x.EntireRow.Insert
                    Set x = x.Offset(-1)
                End If
                '// Gas Day value
                x.Value = c.Value
                x.NumberFormat = "dd-mmm-yy"
                '// Calendar Day value (from filename)
                x.Offset(, 1).Value = fDate
                x.Offset(, 1).NumberFormat = "dd-mmm-yy"
                '// Filename to Remco
                x.Offset(, 5).Value = strFileTEMP
                '// Total MIRN's
                x.Offset(, 6).Value = wsTEMP.Cells(wsTEMP.Rows.Count, 1).End(xlUp).Row - 1
                '// Enter as Original or Latest file
'                If x.Row = 33 Then Stop
                If rngFind Is Nothing Then x.Offset(, 2).Value = "O"
                If Not rngFind Is Nothing Then x.Offset(, 3).Value = "L"
                '// Total of Type_Of_Read A
                x.Offset(, 7).Value = WorksheetFunction.CountIf(wsTEMP.Cells(1, wsTEMP.Columns.Count).End(xlToLeft).EntireColumn, "A")
                '// Total of Type_Of_Read E
                x.Offset(, 8).Value = WorksheetFunction.CountIf(wsTEMP.Cells(1, wsTEMP.Columns.Count).End(xlToLeft).EntireColumn, "E")
                '// Total of Type_Of_Read S
                x.Offset(, 9).Value = WorksheetFunction.CountIf(wsTEMP.Cells(1, wsTEMP.Columns.Count).End(xlToLeft).EntireColumn, "S")
                Set rngFind = Nothing
                Set rngMIRNLoop = ws.Range("K" & x.Row & ":" & ColLet(ws.Cells(2, ws.Columns.Count).End(xlToLeft).Column) & x.Row)
                Debug.Print rngMIRNLoop.Address
                For Each rngMIRN In rngMIRNLoop
                    Debug.Print rngMIRN.Address(0, 0)
                    iMIRN = Evaluate("=VLOOKUP(" & ColLet(rngMIRN.Column) & "2," & strFileTEMP & "!A:AC,28,0)")
                    If Not IsError(iMIRN) Then
                        ws.Cells(iRow, rngMIRN.Column).Value = iMIRN
                    End If
                Next rngMIRN
                If Len(ws.Range("GP" & x.Row).Value) = 0 Then ws.Range("GP" & x.Row).Value = 0
                ws.Range("A" & x.Row & ":E" & x.Row).HorizontalAlignment = xlCenter
                ws.Range("F" & x.Row & ":J" & x.Row).InsertIndent 1
                ws.Range("GQ" & x.Row).Formula = "=SUM(K" & x.Row & ":GP" & x.Row & ")/1000000"
                ws.Range("K5:GO" & ws.Cells(ws.Rows.Count, 1).End(xlUp).Row).NumberFormat = "0,000"
                If blnWasOpenTEMP = False Then
                    wbTEMP.Close False
                End If
                Set wbTEMP = Nothing
                Set wsTEMP = Nothing
SkipWbTEMP:
            Next i
        End If
    End With
    With ws.Range("A5", ws.Cells(ws.Cells(ws.Rows.Count, 1).End(xlUp).Row, ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column))
        .Sort Key1:=ws.Range("A5"), Order1:=xlAscending, Key2:=ws.Range("F5"), Order2:=xlAscending, Header:=xlNo
    End With
ExitHere:
    With Application
        .CutCopyMode = False
        .DisplayAlerts = True
        .EnableEvents = True
        .ScreenUpdating = True
        .StatusBar = False
    End With
    If blnDataCopied = True Then
        MsgBox "Data copied over.", vbInformation, "Complete!"
    Else
        MsgBox "No data was copied over.", vbInformation, "Complete!"
    End If
End Sub

See if that works for you. Let me know.

-----------
Regards,
Zack Barresse