Below is VBA code that runs the Sub HHDDaily(). This Sub calls the Sub HHD() which in turn runs through some code to open each CSV file in a folder one by one, format the data and copy the results to the original Worksheet. It does this be calling 4 more Sub: Addrows, SumDaily, Dates and FindKWH. I've tested it a number of times and it works great until it gets to the final Sub FindKWH, where it's failing to find the lookup values and then when finishing the code in Sub HHD() for each Worksheet that is called, it just copies a blank column for the data that should have been found using 'Call FindKWH'.
Can anyone see why this Sub FindKWH isn't finding what it needs? I've run each Sub independently and when I do that they all work (including Sub FindKWH), so I don't know why it doesn't work as a part of this whole automated process.
Any help fixing this would be greatly appreciated. I've spend hours getting all this to work and this is the final hurdle!
Can anyone see why this Sub FindKWH isn't finding what it needs? I've run each Sub independently and when I do that they all work (including Sub FindKWH), so I don't know why it doesn't work as a part of this whole automated process.
Any help fixing this would be greatly appreciated. I've spend hours getting all this to work and this is the final hurdle!
Code:
Option Explicit
'PROBLEMS WITH THIS MODULE:
' 1. It doesn't do the VLOOKUP at all
Sub HHDDaily()
Application.ScreenUpdating = False
Call HHD
Application.ScreenUpdating = True
End Sub
'It takes the name of each file from Sheet4 (obtained through Module 1) and imports all the daily kWh usage data (along with the file name to identify each row) for every file in the given folder. Before importing the data, it converts the HHD to daily data.
Sub HHD()
Dim wsList As Worksheet, wsOUT As Worksheet
Dim FileName As Range, LoggerID As Range, ID As String
Dim wbData As Workbook, NR As Long, LR As Long, srchPATH As String
Dim Data As Integer
srchPATH = "C:\Users\Nick\Desktop\Data Analysis - July 2015\HHD\" 'remember the final \ in this string path
Set wsList = ThisWorkbook.Sheets("Sheet4") 'the sheet with the file names
Set wsOUT = ThisWorkbook.Sheets("Sheet3") 'set a new output sheet for CSV importing
wsOUT.Cells.Clear 'reset
NR = 1 'set first empty target row
On Error Resume Next 'insure macro keeps going if a file is not found
For Each FileName In wsList.Range("B1:B270") 'cycle through each FileName individually in Sheet4
ID = FileName 'extract the ID itself
Set wbData = Workbooks.Open(srchPATH & ID) 'search for the file using the file name in the folder
If Not wbData Is Nothing Then 'make sure a file was opened
Call AddRows
Call SumDaily
Call Dates
Call FindKWH
Data = wbData.Sheets(1).Range("N1:N65535").SpecialCells(xlCellTypeConstants, 23).Cells.Count 'Test - Count number of cells in the range that aren't blank
wsOUT.Range("A" & NR).Resize(Data).Value = ID 'insert the FileName, then copy the data
wsOUT.Range("B" & NR).Resize(Data).Value = wbData.Sheets(1).Range("N1:N65535").Value 'making sure get all the previous read dates
wsOUT.Range("C" & NR).Resize(Data).Value = wbData.Sheets(1).Range("O1:O65535").Value 'making sure get all the current read dates
wbData.Close False 'close the found workbook
Set wbData = Nothing 'reset
NR = Cells(Rows.Count, 2).End(xlUp).Row + 1 'increment to next empty target row + 1 so don't miss last row!
End If
Next FileName
End Sub
Sub AddRows()
Dim FinalRow As Integer
Dim v As Integer
Dim w As Integer
FinalRow = Cells(Rows.Count, 2).End(xlUp).Row
v = FinalRow
w = v - 1
Do Until (v = 2)
If (Cells(v, 2).Value = Cells(w, 2).Value) Then
v = v - 1
w = w - 1
Else
Rows(v & ":" & w + 2).Insert
v = v - 1
w = w - 1
End If
Loop
End Sub
Sub SumDaily()
Dim FinalRow As Integer
Dim p As Integer
Dim EndRow As Integer
Dim Counter1 As Integer
Dim Counter As Integer
Dim StartRow As Integer
Dim Counter2 As Integer
Dim CalcRow As Integer
Worksheets(1).Activate
FinalRow = Cells(Rows.Count, 2).End(xlUp).Row
p = 1
StartRow = p
Counter2 = 1
CalcRow = FinalRow + 1
For p = 1 To CalcRow
If IsEmpty(Cells(p, 3).Value) Then
EndRow = p - 1
Cells(Counter2, 10).Value = Cells(EndRow, 2).Value
Range("K" & Counter2) = Application.Sum(Range(Cells(StartRow, 4), Cells(EndRow, 4)))
p = p + 2
StartRow = p
Counter2 = Counter2 + 1
End If
Next p
End Sub
Sub Dates()
Dim FirstDate As Date
Dim LastDate As Date
Dim r As Long
FirstDate = Range("J1").Value
LastDate = Cells(Rows.Count, 10).End(xlUp).Value
r = 1
Do
FirstDate = FirstDate
Cells(r, 14) = FirstDate
FirstDate = FirstDate + 1
r = r + 1
Loop Until FirstDate = LastDate + 1
End Sub
Sub FindKWH()
Dim Row As Long
Dim Col As Long
Dim KWH As Long
Dim LastRowT1 As Long
Dim LastRowT2 As Long
Dim LastColT2 As Long
Dim Table1 As Range
Dim Table2 As Range
Dim cl As Range
LastRowT1 = Cells(Rows.Count, 10).End(xlUp).Row 'Find the last row in column J
LastRowT2 = Cells(Rows.Count, 14).End(xlUp).Row 'Find the last row in column N
Set Table1 = Sheet1.Range("J1:K" & LastRowT1) 'Define the table to look up the date/number from
Set Table2 = Sheet1.Range("N1:N" & LastRowT2) 'Define the table for each lookup value
Row = Sheet1.Range("O1").Row 'The starting row for each vlookup output
Col = Sheet1.Range("O1").Column 'The starting column fo each vlookup output
For Each cl In Table2
On Error Resume Next
KWH = Application.Vlookup(cl, Table1, 2, False) 'Think this is where the problem is! It should make 'Value' = to what's found in Table 1 column 2 next to the date that's been found
If KWH > 0 Then 'If what was found is a number
Sheet1.Cells(Row, Col).Value = KWH 'Then put that number in O1
Row = Row + 1 'Make the next output cell O1+1=O2
Else
Sheet1.Cells(Row, Col).Value = 0 'If what was found in the vlookup isn't a number then output 0
Row = Row + 1 'Make the next output cell O1+1=O2
End If
Next cl 'Look for the next date
End Sub
Last edited:
