VBA Code: Problem integrating a Sub into a Module - Vlookup problem? Please Help

[Nick_86]

Hi all, I'll try my best to explain. I've spent hours working on this code and it all works fine when I test each individual Sub. However, when I put each of the 4 Sub's together into one Module (Module 3) in a Master Worksheet and then try and call them from the master Sub, the first 3 work but the last one (Sub FindKWH, which is a vlookup) doesn't work.

What it does

The main excel file with the module in it has 4 sheets (Sheet1, Sheet2, Sheet3, Sheet4). Sheet 4 has a list of file names in Column B (I've limited it to 4 for this example to save space, but in reality there are 240 files/240 rows in Column B listing their names):

Sheet4, COLUMN B (4 rows):
[TABLE="width: 64"]
<tbody>[TR]
[TD="width: 64"]Log_20150714150847_GPRS_SN_020141100181_PMD_SN_0234891104.csv[/TD]
[/TR]
[TR]
[TD]Log_20150714150907_GPRS_SN_020141100152_PMD_SN_0234891144.csv[/TD]
[/TR]
[TR]
[TD]Log_20150714150927_GPRS_SN_020141100199_PMD_SN_0234891123.csv[/TD]
[/TR]
[TR]
[TD]Log_20150714150944_GPRS_SN_020141100191_PMD_SN_0234891132.csv[/TD]
[/TR]
[TR]
[TD][/TD]
[/TR]
</tbody>[/TABLE]
Sheet3 is blank and this is where I want my data populated with Column A for the file name, Column B for Date and Column C for a number (KWH value).

The macro does the following: it looks at each file name in Sheet4, Column B (one at a time), finds that file (which is a CSV file) in the specified folder, opens it up and then through the use of each of the 4 Subs (AddRows, SumDaily, Dates, FindKWH) it does the following respectively to manipulate and format the data how I want it before copying and pasting to the main file Columns B & C (Column A being the name of the file where the data came from):

1. AddRows: Adds 2 blank rows between each day in the data (the data is half-hourly, so there is a column for dates having 48 dates that are the same with a time column next to it that increments by the half hour, i.e. 0:00:00, 0:30:00, 1:00:00 etc. and then a kWh figure in the next column for the Kwh's used in that half hour period). So there are 48 rows for each day then 2 blank rows, then 48 rows for the next day, then 2 blank rows etc. Hope this makes sense?

i.e. (the space between 25/02/2104 and 26/02/2014 are the two blank rows that are added by AddRows, there are no blank rows between each day when the Worksheet is first opened):

[TABLE="width: 316"]
<tbody>[TR]
[TD="align: right"]25/02/2015[/TD]
[TD="align: right"]22:00:00[/TD]
[TD="align: right"]321[/TD]
[/TR]
[TR]
[TD="align: right"]25/02/2015[/TD]
[TD="align: right"]22:30:00[/TD]
[TD="align: right"]279[/TD]
[/TR]
[TR]
[TD="align: right"]25/02/2015[/TD]
[TD="align: right"]23:00:00[/TD]
[TD="align: right"]291[/TD]
[/TR]
[TR]
[TD="align: right"]25/02/2015[/TD]
[TD="align: right"]23:30:00[/TD]
[TD="align: right"]331[/TD]
[/TR]
[TR]
[TD="align: right"]26/02/2015[/TD]
[TD="align: right"]0:00:00[/TD]
[TD="align: right"]242[/TD]
[/TR]
[TR]
[TD="align: right"]26/02/2015[/TD]
[TD="align: right"]0:30:00[/TD]
[TD="align: right"]157[/TD]
[/TR]
</tbody>[/TABLE]

2. SumDaily: It takes each day (so the 48 rows with the same date) and outputs into Column J only one of each date. Next to that date it gives the total value of the kWH summed in the 48 rows for that date (so a figure for the kWh's used in that day).

3. Dates: As the half-hourly data skips some days here and there altogether, this Sub takes the first day found from step 2 (i.e. the date in J1 where the list of dates start) and the last date at the bottom of the J column and then populates the full list of dates in Column N including any days that were skipped.

4. FindKWH: Now I have the full list of dates without any days missing in Column N, this Sub does a Vlookup of each days in Column N, finds that date in Colum J and returns the KWH number next to it (i.e. in normal Excel it would be =VLOOKUP(N1,$J$1:$K$225,2,FALSE)) if there were 225 rows for example. For days that are missing it returns a value of 0.

So Steps 1-4 are run for each Worksheet that is opened by Sub HHD(), and it takes the results (Columns N and O where the complete list of dates and the KWH used on each of the dates are) and pastes them into Columns B and C in the main Worksheet. Next to each of these rows with a date/KWH number, it gives the filename of where they come from. It then closes that Worksheet and opens the next one, with the results (Columns N and O along with the file name) being pasted into the next free row in Columns A, B, C in the main Worksheet.

The end result of all of this should be 240 Worksheets that have been opened, manipulated and then had the results pasted in Columns A, B and C of the main Worksheet.

What actually happens when I run this Module is it works through it all and I end up with a list of file names and dates in Columns A and B, but no KWH figures in Column C.

Any help with what's going wrong (I'm sure the error must be in Sub FindKW) would be much appreciated.

Here is a link to download the Worksheet and example files: http://www.filedropper.com/dataanalysis-july2015
Just need to change the line srchPATH = "C:\Users\Nick\Desktop\Data Analysis - July 2015\HHD\ to the address of where the folder is on your Desktop once you've unzipped it and you can run Module 3 and see what happens.

Option Explicit

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("J2:J65535").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

 

[Nick_86]

I've also found another problem with this Module. For some reason it is not taking the entire range of the full list of dates generated in Step 3, it chops some rows off near the bottom. This doesn't happen when I use each module individually on a single Worksheet. Just can't figure out why these errors are happening...