VBA code for Macro for importing data from multiple Worksheets

[Nick_86]

Hi all,

I haven't been using VBA for very long and am on a steep learning curve. I've seen a lot of code that comes close to doing what I want, but having problems writing a macro to do my specific task. I apologize in advance for the amount of information. If anyone can help with code for any of the steps required it would be much appreciated!

I have the following data, assume the file path to all files is 'C:\Users\Nick\Desktop\Data Analysis - July 2015'. If I mention a folder, then the folder is in this 'Data Analysis - July 2015' folder on my Desktop.

1. 'Participant Details' Worksheet: This contains a list of 240 households data including HouseID, LoggerNumber & TestGroup. All of these are located in the first sheet 'Sheet 1' in a table.
- The HouseID is a 5 character string, with the first character a letter followed by 4 numbers, i.e. K2001. The HouseID's are in the range C14:C270
- The LoggerNumber is a 9 digit number in quotations, i.e. '234892074'. All the Logger Numbers start with 23489, it is only the last 4 digits that change. The LoggerNumber's are in the range AC14:AC270.
- The TestGroup will be one of three: Test 1, Test 2 or Low Intervention. The TestGroup's are in the range N14:N270

2. A folder called 'House Data' that contains an Excel Worksheet for each of the HouseID given in 1.
- Each Worksheet is named HouseID_Address_Meter Number, i.e. K2001_Street_NMI 8001800458
- In each spreadsheet there is a date in the range O3:O14 in the format YYYMMDDHHMMSS as a Number and a KWH number (an integer) in the range S3:S14.

3. A folder called 'HHD' that contains half-hourly interval data for kWh usage for each house each in an Excel CSV File.
- Each CSV File is named 'Log_xxxxxxxxxxxxxx_GPRS_SN_xxxxxxxxxxxx_PMD_SN_********** where all the x's are numbers and change with each name and the *'s are the 9 digit 'LoggerNumber' mentioned in point 1. but with a leading 0, i.e. 0234892074
- In each CSV File there are the dates, times and KWH numbers in separate columns. The 'Date' range is B2:B11014, the 'Time' range is C2:C11014 and the KWH number is in the range D2:D11014. So for each row there is a date in Column B, a time in Column C and the KWH number in Column D. It is half-hourly data so for each day Column B has 48 rows of the same date (i.e. 01/01/2015) while the time increases in half hour increments in Column C from 0:00:00 until 23:30:00 and then the date goes to the next day (02/01/2015) and the time starts again at 0:00:00. Column D has the KWH usage of the house recorded in each period.

What I am trying to do:
A. Open the 'Participant Details' Worksheet with my table in 'Sheet 1'. In 'Sheet 2' I want to be able run a Macro that does the following:

- Looks at the first 'HouseID' i.e. C14 in the range C14:C270. Then searches for this 5 character string (i.e. K2001) in the 'House Data' folder. Is it possible to search for the file looking at only the first 5 characters of the Excel Worksheet name? If so, when it finds the right Worksheet it opens it and copies all the dates and KWH numbers in the ranges given in point 2 above (i.e. O3:O14 and S3:S14 for date and KWH respectively) and pastes them in Sheet 2 in Columns B and C (can start at Row 1). In Row A, to be able to identify these dates and KWH numbers I would like to paste the 'HouseID' in each row for which there is a date and KWH number. i.e. if the dates/KWH is from B1:B12/C1:C12 then in A1:A12 it will have the HouseID.

- Once this is completed it takes the next HouseID and does the same thing but pasting the data in the next empty cells in Columns A, B, C. This will then complete for all the HouseID's generating a long list of HouseID's in Column A, Date in Column B and KWH numbers in Column C. I can then use a filter in excel to find an individual HouseID to see just the data for that house.

B. Open the 'Participant Details' Worksheet with my table in 'Sheet 1'. In 'Sheet 3' I want to be able run a Macro that does the following:

- Looks at the first 'LoggerNumber' (9 digit number in quotations, i.e. '234892074') in the range AC14:AC270 and then searches using only the last 4 digits (not including the ') of this number (i.e. 2074) for the right CSV File in the 'HHD' folder. It will only compare these 4 digits to the last 4 digits of each file name (right(4,2074)?) to find the right CSV.

- Once the right CSV is found the code runs a SUB to clean the data. By this I want to convert the half-hourly data into daily data. i.e. For each Date in column B that is the same (so 48 for each date) take the associated KWH number in Column D (same row) and adds all the KWH numbers (48 of them). The result of this is in Column J and K (starting at row 1) I will then have a list of dates and the total KWH usage used on each day. I think I have already been able to do this SUB:

 Sub NickData()    Call AddRows
    Call SumDaily
 End Sub
Sub AddRows()
'Adds 2 blank rows between each day


  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

- So now that I have the daily data with Dates in Column J and KWH numbers in Column K I want to take this entire range i.e. J1:Kx (x = last row with a number in it) and paste this data into my 'Participant Details' Worksheet in Sheet 3 in Columns B and C. Again, for Column A I want to paste the last 4 digits of the logger number (i.e. 2074) next to each Date/KWH number.

- Once this is completed it takes the next LoggerNumber and does the same thing but pasting the data in the next empty cells in Columns A, B, C. This will then complete for all the LoggerNumbers generating a long list of LoggerNumbers in Column A, Date in Column B and KWH numbers in Column C. I can then use a filter in excel to find an individual LoggerNumber to see just the data for that house.

 

[jbeaucaire]

After reading this over several times, this macro seems to my eye suited for what you've asked:

Option Explicit

Sub ImportsInformation()
Dim wsList As Worksheet, wsOUT As Worksheet
Dim HouseID As Range, LoggerID As Range, ID As String
Dim wbData As Workbook, NR As Long, LR As Long, srchPATH As String

srchPATH = "C:\Users\Nick\Desktop\Data Analysis - July 2015\"       'remember the final \ in this string path
Set wsList = ThisWorkbook.Sheets("Sheet1")                          'the sheet with the IDs (Participant Details)
Set wsOUT = ThisWorkbook.Sheets("Sheet2")                           'the sheet to build the list into

wsOUT.Cells.Clear                                                   'clear the build sheet
NR = 1                                                              'set first empty target row

On Error Resume Next                                                'insure macro keeps going if a file is not found

For Each HouseID In wsList.Range("C14:C270")                        'cycle through each HouseID individually
    ID = Left(HouseID, 5)                                           'extract the ID itself
    Set wbData = Workbooks.Open(srchPATH & ID & "*.xl*")            'do a wildcard search for the ID in the folder
    If Not wbData Is Nothing Then                                   'make sure a file was opened
        wsOUT.Range("A" & NR).Resize(12).Value = ID                 'insert the houseID, then copy the data
        wsOUT.Range("B" & NR).Resize(12).Value = wbData.Sheets(1).Range("O3:O14").Value
        wsOUT.Range("C" & NR).Resize(12).Value = wbData.Sheets(1).Range("S3:S14").Value
        wbData.Close False                                          'close the found workbook
        Set wbData = Nothing                                        'reset
        NR = NR + 12                                                'increment to next empty target row
    End If
Next HouseID

srchPATH = "C:\Users\Nick\Desktop\HHD\"                             'remember the final \ in this string path
Set wsOUT = ThisWorkbook.Sheets("Sheet3")                           'set a new output sheet for CSV importing
wsOUT.Cells.Clear                                                   'reset
NR = 1                                                              'set first empty target row

For Each LoggerID In wsList.Range("AC14:AC270")                     'cycle through each HouseID individually
    ID = Right(Replace(LoggerID, "'", ""), 4)                       'extract the ID itself
    Set wbData = Workbooks.Open(srchPATH & "*" & ID & ".csv")       'do a wildcard search for the ID in the folder
    If Not wbData Is Nothing Then                                   'make sure a file was opened
        Call AddRows
        Call SumDaily
        LR = wbData.Sheets(1).Range("A" & Rows.Count).End(xlUp).Row
        wsOUT.Range("A" & NR).Resize(LR).Value = ID                 'insert the LoggerID, then copy the data
        wsOUT.Range("B" & NR).Resize(LR, 2).Value = wbData.Sheets(1).Range("J1:K" & LR).Value
        wbData.Close False                                          'close the found workbook
        Set wbData = Nothing                                        'reset
        NR = NR + LR                                                'increment to next empty target row
    End If
Next HouseID

End Sub

 

[Nick_86]

Great, thanks jbeaucaire. I'll have a play with it and see how it goes. Thanks for your help!

 

[Nick_86]

Hi jbeaucaire,
I've tried using the code with a couple of modifications, breaking each stage into a separate Sub so I can test separately and modifying a couple of locations. However, when I try to run the first Sub HouseData() it runs without errors but nothing is generated in the spreadsheet. Running the Sub HHD() gives a Run-time error '91': Object variable or With block variable not set.
Any suggestions?
Thanks,
Nick

 

[Nick_86]

Sorry, forgot to include the code!:

Option ExplicitSub Gosnells()
    Call HouseData
    Call HHD
End Sub


Sub HouseData()
Dim wsList As Worksheet, wsOUT As Worksheet
Dim HouseID As Range, LoggerID As Range, ID As String
Dim wbData As Workbook, NR As Long, LR As Long, srchPATH As String


srchPATH = "C:\Users\Nick\Desktop\Data Analysis - July 2015\House Data\"    'remember the final \ in this string path
Set wsList = ThisWorkbook.Sheets("Sheet1")                                  'the sheet with the IDs (Participant Details)
Set wsOUT = ThisWorkbook.Sheets("Sheet2")                                   'the sheet to build the list into


wsOUT.Cells.Clear                                                           'clear the build sheet
NR = 1                                                                      'set first empty target row


On Error Resume Next                                                        'insure macro keeps going if a file is not found


For Each HouseID In wsList.Range("C14:C270")                                'cycle through each HouseID individually
    ID = Left(HouseID, 5)                                                   'extract the ID itself
    Set wbData = Workbooks.Open(srchPATH & ID & "*.xl*")                    'do a wildcard search for the ID in the folder
    If Not wbData Is Nothing Then                                           'make sure a file was opened
        wsOUT.Range("A" & NR).Resize(12).Value = ID                         'insert the houseID, then copy the data
        wsOUT.Range("B" & NR).Resize(12).Value = wbData.Sheets(1).Range("O3:O14").Value
        wsOUT.Range("C" & NR).Resize(12).Value = wbData.Sheets(1).Range("S3:S14").Value
        wbData.Close False                                                  'close the found workbook
        Set wbData = Nothing                                                'reset
        NR = NR + 12                                                        'increment to next empty target row
    End If
Next HouseID


End Sub


Sub HHD()


Dim wsList As Worksheet, wsOUT As Worksheet
Dim HouseID As Range, LoggerID As Range, ID As String
Dim wbData As Workbook, NR As Long, LR As Long, srchPATH As String


srchPATH = "C:\Users\Nick\Desktop\Data Analysis - July 2015\HHD\"           'remember the final \ in this string path
Set wsOUT = ThisWorkbook.Sheets("Sheet3")                                   'set a new output sheet for CSV importing
wsOUT.Cells.Clear                                                           'reset
NR = 1                                                                      'set first empty target row


For Each LoggerID In wsList.Range("AC14:AC270")                             'cycle through each HouseID individually
    ID = Right(Replace(LoggerID, "'", ""), 4)                               'extract the ID itself
    Set wbData = Workbooks.Open(srchPATH & "*" & ID & ".csv")               'do a wildcard search for the ID in the folder
    If Not wbData Is Nothing Then                                           'make sure a file was opened
        Call AddRows
        Call SumDaily
        LR = wbData.Sheets(1).Range("A" & Rows.Count).End(xlUp).Row
        wsOUT.Range("A" & NR).Resize(LR).Value = ID                         'insert the LoggerID, then copy the data
        wsOUT.Range("B" & NR).Resize(LR, 2).Value = wbData.Sheets(1).Range("J1:K" & LR).Value
        wbData.Close False                                                  'close the found workbook
        Set wbData = Nothing                                                'reset
        NR = NR + LR                                                        'increment to next empty target row
    End If
Next LoggerID


End Sub


Sub AddRows()
  
  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

 

[jbeaucaire]

Comment out the On Error Resume Next line of code, then run it and hope it errors. When it does, DEBUG and analyze the values of the variables on the line of code. What are they? How are the inaccurate?

==========

When you created separate macros, you didn't include the SET wsLIST code in the second macro.

 

[Nick_86]

Thanks for the reply. I've added the SET wsLIST to the second macro, thanks for spotting.
When I comment out the On Error Resume Next and run it errors - Run-time error '1004': Application-defined or object-defined error.
If I then cycle through the code using F8 it highlights the rows yellow but then produces the error message again when it gets to the line:

If Not wbData Is Nothing Then                                           'make sure a file was opened

If this isn't the way to do it, please could you explain how to "DEBUG and analyze the values of the variables on the line of code"?

 

[Nick_86]

Hi, I think I've figured it out. The problem was that when searching for the file using only the 5 characters of the HouseID it doesn't find it because the file name is a string that contains other characters as well. Also, I don't think the Sheet1 was activated so I added a line to activate Sheet1 as the target sheet of the macro. Now all I think I need to do is write another SUB to run before the Sub HouseData() SUB in order to get the full file names of each of the Worksheets in the folder. I can then use the range of file-names to search for each worksheet.

Also, I'm not sure the wildcard code was correct, I was getting an error at one point looking for the wrong extension so I changed the search to .xlxs file types.

Here is the code if anyone is interested. As said above, just need to write the SUB now to get the full list of file names. Then it's only making sure the other SUB's work.

Thanks again for your help Jerry.

Option ExplicitSub Gosnells()
    Call HouseData
    Call HHD
End Sub


Sub HouseData()
Dim wsList As Worksheet, wsOUT As Worksheet
Dim HouseID As Range, LoggerID As Range, ID As String
Dim wbData As Workbook, NR As Long, LR As Long, srchPATH As String


srchPATH = "C:\Users\Nick\Desktop\Data Analysis - July 2015\House Data\"    'remember the final \ in this string path
Set wsList = ThisWorkbook.Sheets("Sheet1")                                  'the sheet with the IDs (Participant Details)
Set wsOUT = ThisWorkbook.Sheets("Sheet2")                                   'the sheet to build the list into


wsOUT.Cells.Clear                                                           'clear the build sheet
NR = 1                                                                      'set first empty target row


On Error Resume Next                                                        'insure macro keeps going if a file is not found


ThisWorkbook.Sheets("Sheet1").Activate                                      ''''Activate Sheet1 to start working in the right sheet


For Each HouseID In wsList.Range("C14:C270")                                ''''*** Need to change this range to the list of file names once run the first module to get the full list of file names***cycle through each HouseID individually
    ID = HouseID                                                            ''''extract the ID itself
    Set wbData = Workbooks.Open(srchPATH & ID & ".xlsx")                    ''''search for the xlsx file using the full file name (ID) in the folder
    If Not wbData Is Nothing Then                                           'make sure a file was opened
        wsOUT.Range("A" & NR).Resize(12).Value = ID                         'insert the houseID, then copy the data
        wsOUT.Range("B" & NR).Resize(12).Value = wbData.Sheets(1).Range("O3:O14").Value
        wsOUT.Range("C" & NR).Resize(12).Value = wbData.Sheets(1).Range("S3:S14").Value
        wbData.Close False                                                  'close the found workbook
        Set wbData = Nothing                                                'reset
        NR = NR + 12                                                        'increment to next empty target row
    End If
Next HouseID


End Sub


Sub HHD()


Dim wsList As Worksheet, wsOUT As Worksheet
Dim HouseID As Range, LoggerID As Range, ID As String
Dim wbData As Workbook, NR As Long, LR As Long, srchPATH As String


srchPATH = "C:\Users\Nick\Desktop\Data Analysis - July 2015\HHD\"           'remember the final \ in this string path
Set wsList = ThisWorkbook.Sheets("Sheet1")                                  'the sheet with the IDs (Participant Details)
Set wsOUT = ThisWorkbook.Sheets("Sheet3")                                   'set a new output sheet for CSV importing
wsOUT.Cells.Clear                                                           'reset
NR = 1                                                                      'set first empty target row


For Each LoggerID In wsList.Range("AC14:AC270")                             'cycle through each HouseID individually
    ID = Right(Replace(LoggerID, "'", ""), 4)                               'extract the ID itself
    Set wbData = Workbooks.Open(srchPATH & "*" & ID & ".csv")               'do a wildcard search for the ID in the folder
    If Not wbData Is Nothing Then                                           'make sure a file was opened
        Call AddRows
        Call SumDaily
        LR = wbData.Sheets(1).Range("A" & Rows.Count).End(xlUp).Row
        wsOUT.Range("A" & NR).Resize(LR).Value = ID                         'insert the LoggerID, then copy the data
        wsOUT.Range("B" & NR).Resize(LR, 2).Value = wbData.Sheets(1).Range("J1:K" & LR).Value
        wbData.Close False                                                  'close the found workbook
        Set wbData = Nothing                                                'reset
        NR = NR + LR                                                        'increment to next empty target row
    End If
Next LoggerID


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

 

[jbeaucaire]

1) Never 'activate' a sheet with VBA, it's a human thing to do, unnecessary in VBA. We've already specifically set the wsList to the correct sheet and we're cycling through those values correctly. No need to 'activate' anything.

2) I think the problem is in the workbooks.open code, try this in my original code, not your tweaked code:

Set wbData = Workbooks.Open(srchPATH & "*" & ID & "*.xl*")                    'do a wildcard search for the ID in the folder

Maybe.

Your original notes said the workbook names STARTED with the ID: K2001_Street_NMI 8001800458 which is why my original code reads:

Set wbData = Workbooks.Open(srchPATH & ID & "*.xl*")                    'do a wildcard search for the ID in the folder

 

[emperorlord]

Dear Jerry Beaucaire
Option Explicit
I used your parse data individual sheets macro
It is really fantastic. But i need some help
When run the macro we have a two option right?
Which is If sheet exists already, add new data to the bottom?" & vbLf & "(if no, new data will replace old data)", _
vbYesNo, "Append new Data?"
But i need only add new data to the bottom option. Because some users checking no my work is deleted.
How can i change this without option and first option aumatically processed?
Maybe you confused which your code i used.
I copied your code below.
Thank you and help me

Sub ParseItems()
'Author: Jerry Beaucaire
'Date: 11/11/2009
'Summary: Based on selected column, data is filtered to individual sheets
' Creates sheets and sorts sheets alphabetically in workbook
' 6/10/2010 - added check to abort if only one value in vCol
' 7/22/2010 - added ability to parse numeric values consistently
' 11/16/2011 - changed way Unique values are collected, no Adv Filter
' 12/23/2013 - option to append incoming data
Dim LR As Long, Itm As Long, MyCount As Long, vCol As Long, iCol As Long, NR As Long
Dim ws As Worksheet, MyArr As Variant, vTitles As String, TitleRow As Long, Append As Boolean

Application.ScreenUpdating = False

'Column to evaluate from, column A = 1, B = 2, etc.
vCol = 1

'Sheet with data in it
Set ws = Sheets("Data")

'option to append new data below old data
If MsgBox(" If sheet exists already, add new data to the bottom?" & vbLf & "(if no, new data will replace old data)", _
vbYesNo, "Append new Data?") = vbYes Then Append = True

'Range where titles are across top of data, as string, data MUST
'have titles in this row, edit to suit your titles locale
vTitles = "A1:Z1"
TitleRow = Range(vTitles).Cells(1).Row

'Spot bottom row of data
LR = ws.Cells(ws.Rows.Count, vCol).End(xlUp).Row

'Get a temporary list of unique values from vCol
iCol = ws.Columns.Count
ws.Cells(1, iCol) = "key"

For Itm = TitleRow + 1 To LR
On Error Resume Next
If ws.Cells(Itm, vCol) <> "" And Application.WorksheetFunction _
.Match(ws.Cells(Itm, vCol), ws.Columns(iCol), 0) = 0 Then
ws.Cells(ws.Rows.Count, iCol).End(xlUp).Offset(1) = ws.Cells(Itm, vCol)
End If
Next Itm
'Sort the temporary list
ws.Columns(iCol).Sort Key1:=ws.Cells(2, iCol), Order1:=xlAscending, _
Header:=xlYes, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

'Put list into an array for looping
MyArr = Application.WorksheetFunction.Transpose _
(ws.Columns(iCol).SpecialCells(xlCellTypeConstants))

'clear temporary list
ws.Columns(iCol).Clear

'Turn on the autofilter
ws.Range(vTitles).AutoFilter

'Loop through list one value at a time
'The array includes the title cell, so we start at the second value in the array
For Itm = 2 To UBound(MyArr)
ws.Range(vTitles).AutoFilter Field:=vCol, Criteria1:=CStr(MyArr(Itm))

If Not Evaluate("=ISREF('" & CStr(MyArr(Itm)) & "'!A1)") Then 'create sheet if needed
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = CStr(MyArr(Itm))
NR = 1
Else 'if it exists already
Sheets(CStr(MyArr(Itm))).Move After:=Sheets(Sheets.Count) 'ordering the sheets
If Append Then 'find next empty row
NR = Sheets(CStr(MyArr(Itm))).Cells(Rows.Count, vCol).End(xlUp).Row + 1
Else
Sheets(CStr(MyArr(Itm))).Cells.Clear 'clear data if not appending
NR = 1
End If
End If

If NR = 1 Then 'copy titles and data

ws.Range("A" & TitleRow & ":A" & LR).Range("a" & TitleRow & ":d" & LR).Copy Sheets(CStr(MyArr(Itm))).Range("A" & NR)
Else 'copy data only
ws.Range("A" & TitleRow + 1 & ":A" & LR).Range("a" & TitleRow & ":d" & LR).Copy Sheets(CStr(MyArr(Itm))).Range("A" & NR)
End If

ws.Range(vTitles).AutoFilter Field:=vCol 'reset the autofilter
If Append And NR > 1 Then NR = NR - 1
MyCount = MyCount + Sheets(CStr(MyArr(Itm))).Range("A" & Rows.Count).End(xlUp).Row - NR
Sheets(CStr(MyArr(Itm))).Columns.AutoFit
Next Itm

'Cleanup
ws.Activate
ws.AutoFilterMode = False
MsgBox "Rows with data: " & (LR - TitleRow) & vbLf & "Rows copied to other sheets: " _
& MyCount & vbLf & "Hope they match!!"

Application.ScreenUpdating = True
End Sub