How to extract data from another Excel worksheet and import it to the Excel where you are working on

We periodically enter data to a Consolidated Worksheet that derives from date two other worksheets.  The two other worksheets are being enter data on a daily basis.  Once a month another user get these 2 worksheets and copy/paste its content to the Consolidated Worksheet.

We are trying to use VBA in order to import the data from the other 2 worksheet.

We have included the 3 excel in question with sample data:
- ConsolidateExcel-Origin1.xlsx - one of  two other worksheets
- ConsolidateExcel-Origin2.xlsx - one of  two other worksheets
- ConsolidateExcel-Final.xlsx - the Consolidated Worksheet

Please advice n how to go about it.
rayluvsAsked:
Who is Participating?
 
Harry LeeCommented:
Alright, I have done editing the code.

This script works with folder instead of individual data files. What you do is, put all your data file into one folder (NOT including the working file). The script will go through the folder for any xlsx, and import them into the current working sheet.

Please test it.

Option Explicit
Function GetFolder(InitDir As String) As String
Dim fldr As FileDialog
Dim sItem As String
sItem = InitDir
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
.Title = "Select a Folder"
.AllowMultiSelect = False
If Right(sItem, 1) <> "\" Then
sItem = sItem & "\"
End If
.InitialFileName = sItem
If .Show <> -1 Then
sItem = InitDir
Else
sItem = .SelectedItems(1)
End If
End With
GetFolder = sItem
Set fldr = Nothing
End Function
Sub ImportData()
'--------------------------------------------------
'   Declare Variables
    Dim strPath As String, strFile As String
    Dim swbk As Workbook, twbk As Workbook
    Dim tws As Worksheet, sws As Worksheet
    Dim twsn As String
    Dim CurRw As Long, I As Long, DataLstRw As Long, CurRwStart As Long, CurRwEnd As Long
    

'--------------------------------------------------
'   Set twbk Object Variables Values
    Set twbk = ActiveWorkbook

'--------------------------------------------------
'   Create new sheet naming using date and time

'    twbk.Sheets.Add.Name = Format(Now, "yyyymmddhhmmss") & "Import"
'    Set tws = ActiveSheet
'    tws.Cells(6, 7) = "Date)"
'    tws.Cells(6, 9) = "Provider"
'    tws.Cells (6, 10) = "Ref"
'    tws.Cells(6, 11) = "Exp"
'    tws.Cells(6, 12) = "Description"
'    tws.Cells(6, 14) = "Dr"
'    tws.Cells(6, 15) = "Cr"
'    tws.Rows(6).Font.Bold = True
    
'--------------------------------------------------
'   Use existing sheet POOrderLine as the target sheet
    Set tws = twbk.Sheets("Sheet1")
    
'--------------------------------------------------
'   Removing old data from Data sheet
'    If Len(Cells(6, 7)) <> 0 Then
'        tws.Range(Rows(6), Rows(Cells(Rows.Count, 7).End(xlUp).Row)).EntireRow.Delete
'    End If

'--------------------------------------------------
'   Get Data folder from user
    strPath = GetFolder("C:\") & "\"
    strFile = Dir(strPath & "*.xlsx")
    
'--------------------------------------------------
'   Removing old data from Data sheet
'    If Len(Cells(6, 7)) <> 0 Then
'        tws.Range(Rows(6), Rows(Cells(Rows.Count, 7).End(xlUp).Row)).EntireRow.Delete
'    CurRw = 6
'    End If


'--------------------------------------------------
'   Define current working row
'
    If tws.Cells(Rows.Count, 7).End(xlUp).Row <= 6 Then
        CurRw = 6
    Else
        CurRw = tws.Cells(Rows.Count, 7).End(xlUp).Row
    End If
    
'--------------------------------------------------
'   Markdown Beginning Row of Import
'
    CurRwStart = CurRw

'--------------------------------------------------
'   Loop through all files in user specified folder tor workbooks
    Do While strFile <> ""
        If Right(strFile, 4) = "xlsx" Then
            Set swbk = Workbooks.Open(Filename:=strPath & strFile)
            Set sws = ActiveSheet
        End If

'--------------------------------------------------
'   Find the Last Valid Row of Data Detail
    DataLstRw = sws.Cells(Rows.Count, 3).End(xlUp).Row
    If Len(Application.WorksheetFunction.Substitute(sws.Cells(DataLstRw, 3), " ", "")) = 0 Then
        DataLstRw = DataLstRw - 1
    End If
'--------------------------------------------------
'   Loop through all detail lines of Data files and copy onto Master sheet
    For I = 18 To DataLstRw
        tws.Cells(CurRw, 7) = sws.Cells(I, 3)       'Date
        tws.Cells(CurRw, 9) = sws.Cells(I, 5)       'Provider
        tws.Cells(CurRw, 10) = sws.Cells(I, 6)      'Ref
        tws.Cells(CurRw, 12) = sws.Cells(I, 8)      'Description
        tws.Cells(CurRw, 14) = sws.Cells(I, 10)      'Dr
        tws.Cells(CurRw, 15) = sws.Cells(I, 11)      'Cr
        CurRwEnd = CurRw                              'Mark down Ending Row of Import
        CurRw = CurRw + 1
    Next
            
'--------------------------------------------------
'   Close Data file
    swbk.Close SaveChanges:=False

'--------------------------------------------------
'   Resume Loop
        strFile = Dir
    Loop

'--------------------------------------------------
'   Sort Current Imported Lines
    tws.Sort.SortFields.Clear
    tws.Sort.SortFields.Add Key:=Range(Cells(CurRwStart, 10), Cells(CurRwEnd, 10)), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortTextAsNumbers
    With tws.Sort
        .SetRange Range(Cells(CurRwStart, 7), Cells(CurRwEnd, 15))
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

'--------------------------------------------------
'   Remove Object Varibles from memory
Set twbk = Nothing
Set tws = Nothing
Set sws = Nothing
End Sub

Open in new window


It's sitting in the attached file call Import Data
ConsolidateExcel-Final.xlsm
0
 
rayluvsAuthor Commented:
0
 
ProfessorJimJamCommented:
question is:   do you need the consolidated final to retain the data and when the next month import happens, it adds it to the final file while retaining the previous record?
0
Cloud Class® Course: SQL Server Core 2016

This course will introduce you to SQL Server Core 2016, as well as teach you about SSMS, data tools, installation, server configuration, using Management Studio, and writing and executing queries.

 
rayluvsAuthor Commented:
Yes, your are correct, thanx for the observation.  Manually that is what's done; the consolidate excel is updated by the newest data entered in the "origin" excel.
0
 
ProfessorJimJamCommented:
unless someone else dives in sooner, I will write a code for you.  but right now. i am at work, so as soon as i get a chance
0
 
rayluvsAuthor Commented:
Ok thanx, but if you can, gives some guideline so we work on it (if it's ok).
0
 
Harry LeeCommented:
I already have codes for that. I just need to customize it a little for you.
0
 
rayluvsAuthor Commented:
Hi, just ran the excels and we are going over them to understand them, but pleas help us with the following in order finalize it:

- After line "If .Show <> -1 Then", the debug doesn't work (we are running debug to
  understand your code).   Yet, when run a 2nd time, it goes to the subsequent lines.  Can we debug complete?
  is it possible, or Debug is disabled when line is executed "sItem = InitDir"?

- When running again, and NO modification has been one on either ConsolidateExcel-Origin1.xlsx
  or ConsolidateExcel-Origin2.xlsx, when importing, it starts writing on the last line it wrote before.  How
  can we have it to write on the next empry line?

  (we have included the files with the test done also we commented out the SORT lines for debugging purposes)

- When running, after simulating a user entering data on ConsolidateExcel-Origin2.xlsx, see
  ref "00005" on same file, when it inputs, it doesn't inputs the last line entered.

- finally, you will noticed that in line "strPath = GetFolder (", we entered the actual folder so we don't
  enter it every time.  This said, can we make it to open the 2 files instead opening windows
  to select the folder?


Note: we have attached the same 3 excel but with our testing so you can refer to it as to our comments above.
ConsolidateExcel-Origin1.xlsx
ConsolidateExcel-Origin2.xlsx
ConsolidateExcel-Final-EE.xlsm
0
 
Harry LeeCommented:
Ok. There are multiple parts to your question.

1.

Which debugger are you using? Are you using the Excel internal debugger? The internal debugger is faulty. It always fail when a user input is requested in the code. As soon as the user provides input, it will no long running step by step.

One trick is to put a break point onto a line in the main Sub right after the request of user input. In this case, put it on the line "    If tws.Cells(Rows.Count, 7).End(xlUp).Row <= 6 Then" and "    DataLstRw = sws.Cells(Rows.Count, 3).End(xlUp).Row" will ensure your step by step debug.

2.

There is a small error in the code causing it to overwrite the last line of data.
Change this
    If tws.Cells(Rows.Count, 7).End(xlUp).Row <= 6 Then
        CurRw = 6
    Else
        CurRw = tws.Cells(Rows.Count, 7).End(xlUp).Row
    End If

Open in new window

To
    If tws.Cells(Rows.Count, 7).End(xlUp).Row <= 6 Then
        CurRw = 6
    Else
        CurRw = tws.Cells(Rows.Count, 7).End(xlUp).Row + 1
    End If

Open in new window


3.

I have retested the code, and cannot recreate the problem you mentioned that newly entered lines are not picked up. Since you have tried modified the code, I'm not going to spend time trying to figure out how did you screwed up the code.
The code use Column C of the source data to determine the last row of data line. Make sure the Data column is entered.
    DataLstRw = sws.Cells(Rows.Count, 3).End(xlUp).Row
    If Len(Application.WorksheetFunction.Substitute(sws.Cells(DataLstRw, 3), " ", "")) = 0 Then
        DataLstRw = DataLstRw - 1
    End If

Open in new window

If you have modified this, it could be the reason for it not picking up the lines.
One possibility is that you are changing the files in the middle of playing around the code in the VBA editor. If you append more rows to the source data after the VBA had already gone through the section which is used to determine the last row of source data, VBA is not going to know it.

4.

GetFolder is a custom function we have defined in
Function GetFolder(InitDir As String) As String
Dim fldr As FileDialog
Dim sItem As String
sItem = InitDir
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
.Title = "Select a Folder"
.AllowMultiSelect = False
If Right(sItem, 1) <> "\" Then
sItem = sItem & "\"
End If
.InitialFileName = sItem
If .Show <> -1 Then
sItem = InitDir
Else
sItem = .SelectedItems(1)
End If
End With
GetFolder = sItem
Set fldr = Nothing
End Function

Open in new window

to get the user input of the data carrying folder and store the path in the variable strPath by using the line strPath = GetFolder("C:\") & "\".

If you don't want the user to select a folder, you don't need to use the GetFolder function.

Change the line
strPath = GetFolder("C:\") & "\"

Open in new window

to
strPath = "C:\Users\RR\Documents\zzzzNew folder\eeXds\New folder\"

Open in new window


NOTE: If you stop using the GetFolder function, you don't need to insert break point to your code for the Excel internal VBA debugger to work.

Hope this can help you to understand the code better.
0
 
rayluvsAuthor Commented:
Thanx will continue tomorrow.
0
 
rayluvsAuthor Commented:

1.

Yes we are using the Excel internal debugger.



2.

The overwrite fixed! Thanx!



3.

Ha, Ha, Ha "..you screwed up the code". FYI, when we tested the code we didn't modified.  Also, when first tested, we didn't enter any data so the column C has the data as the first excels did.



4.

For the issue of "strPath = GetFolder", we sent back the excels (see ID: 40771653) with the change you suggested here, but that was only because we didn't want to search for the folder instead go into it (since we don't know how to open the excel files directly).  That being said, how can we make it to open the 2 files instead?
0
 
Harry LeeCommented:

1.

If you are not getting user input for the folder location, this is irrelevant.

3.

Have no clue what cause your problem. Regardless, the problem cannot be recreated after repeat testing.

4.

It is possible to make the script 2 specific files you want. In fact, It's easier to get VBA to loop through all the files in a folder and work on all the xlsx instead of getting it to open 2 specific files.

Opening 2 specific files is no longer a loop but getting vba to open specific files using Workbook.Open. How many origin files are you going to have?
0
 
rayluvsAuthor Commented:
For this main Excel, 2 files it feeds from.
0
 
Harry LeeCommented:
Can you keep the structure of the VBA, and keep only the 2 source files in a folder?
0
 
rayluvsAuthor Commented:
Not for this specific user; having him navigate or having the "Folder" screen is troublesome.

Would the structure change significant if having opening the 2 files directly?  

How about making it for importing one file instead and copy the script as 2d script for the other file?
0
 
Harry LeeCommented:
You don't need separate procedure to do the job. It can be done all in one procedure.

Just so that you know, it's not asking the user for the folder, in the latest code I have provided, but hard coded in the VBA procedure. strPath = "C:\Users\RR\Documents\zzzzNew folder\eeXds\New folder\"

The structure of the code will change a lot. Currently, 5 lines out of the whole procedure is used to look into all the xlsx in a folder.

To make it opening the 2 specific files, will remove the 5 lines of loop, and add a few Bookmarks, and Goto to make the code jumping back and fore to achieve that.

Imagine, the Chorus in a song lyrics.

Basically, get the code to open the 1st file, then use goto to jump to the section of code to extract the data then close the 1st source file.

Next, use GoTo to resume the main section of the code to open the 2nd file and use GoTo to jump to the data extraction code again. When done, Jump back to the main section and continue with the formatting and sorting.

Or, simple put everything in a straight run through, with the extraction part duplicated.
0
 
rayluvsAuthor Commented:
Understood.  We don't want you to work more that you have to.

Ok, so we can close this question and finish, we will stay with the structure of the VBA as is which opens the Select a Folder windows and imports the excels in that folder.

We are testing it for while and get back to you.
0
 
Harry LeeCommented:
Sure.

If you really want to open the specific two files, I can work on it next week Thursday. I would be busy Tuesday and Wednesday.
0
 
rayluvsAuthor Commented:
Ok finished.

We noticed that the excels imported. Origin1 and Origin1 are imported completely; which is perfect the first time.  But when imported a second time, it import both files entirely; thus the consolidated-Final excel will have duplicate data.

Looking at the code, the line "For I = 18 To DataLstRw" has the 18 that tells where to start importing of excel Origin1 and Origin2.  So every time it imports, it starts from the beginning, the 18 row; thus the duplicity.  What if we use the column B and have the user place an X to all the lines he imported that day.  And when the next time the Excel-Final is run, instead of starting the import from 18, it would start after the last "X" in the column B.

Made the changes and it seems to work.  

The line "DataLstRw = sws.Cells(Rows.Count, 3).End(xlUp).Row", we used it to calculate the lines not yet imported by making look into column B; modified it to "DataLstRw = sws.Cells(Rows.Count, 2).End(xlUp).Row"

So the loop looks like this:
'   Loop through all detail lines of Data files and copy onto Master sheet
    DataLstRw2 = sws.Cells(Rows.Count, 2).End(xlUp).Row
    If DataLstRw2 <> 17 Then           'Only if there is new lines
       If DataLstRw2 <> DataLstRw Then 'Only if there is new lines
          For I = (DataLstRw2 + 1) To DataLstRw '18 To DataLstRw
              tws.Cells(CurRw, 7) = sws.Cells(I, 3)       'Date
              tws.Cells(CurRw, 9) = sws.Cells(I, 5)       'Provider
              tws.Cells(CurRw, 10) = sws.Cells(I, 6)      'Ref
              tws.Cells(CurRw, 12) = sws.Cells(I, 8)      'Description
              tws.Cells(CurRw, 14) = sws.Cells(I, 10)      'Dr
              tws.Cells(CurRw, 15) = sws.Cells(I, 11)      'Cr
              CurRwEnd = CurRw                              'Mark down Ending Row of Import
              CurRw = CurRw + 1
          Next
       End If
    End If

Open in new window


What you think?

Please note:
When changing the line "strPath = "C:\Users\RR\Documents\zzzzNew folder\eeXds\New folder\" & "\""" to as you instructed in ID: 40780219, it display the folder but then when pressing OK, it does nothing.  Can we make it look to the folder without opening it?
0
 
rayluvsAuthor Commented:
(will send you the files so you can see it run and give us your observation)
0
 
rayluvsAuthor Commented:
0
 
rayluvsAuthor Commented:
Hi just read your entry on ID: 40780290.  Please don't over work on it.  With what you have helped us is more than enough.

Please review our last entry and advice.

Thank you very much for all your help!
0
 
Harry LeeCommented:
I will look into this when I get back to the office next week.
0
 
rayluvsAuthor Commented:
Hi,

Just wanted to update our question.

We have modified the script to import data from the two (2) excels (‘ConsolidateExcel-Origin1.xlsx’ and ‘ConsolidateExcel-Origin2.xlsx’) only the there is NO “X” next to data line being and imported by ‘ConsolidateExcel-Final-EE.xlsm’.

Works Ok.

However, we have 2 problems:

1. How can we make the script to open the two (2) excels in their original locations (in real life, these files
    are in totally different location)?
    (in other words, not to have the user choose the folder every time it needs to import data)
    [we understand that you said that this may change the script entirely, and we don't want you to re-work it, but
    can you give us a guide line so we can work on it}

2. How can we place “X” when the script is reading the two (2) excels?
    in other words, place the command within these lines, since it is when it is being read:

'   Loop through all detail lines of Data files and copy onto Master sheet
    DataLstRw2 = sws.Cells(Rows.Count, 2).End(xlUp).Row
    If DataLstRw2 >= 17 Then                              'Only if there is new lines
       If DataLstRw2 <> DataLstRw Then                    'Only if there is new lines
          For I = (DataLstRw2 + 1) To DataLstRw           '18 To DataLstRw
              tws.Cells(CurRw, 7) = sws.Cells(I, 3)       'Date
              tws.Cells(CurRw, 9) = sws.Cells(I, 5)       'Provider
              tws.Cells(CurRw, 10) = sws.Cells(I, 6)      'Ref
              tws.Cells(CurRw, 12) = sws.Cells(I, 8)      'Description
              tws.Cells(CurRw, 14) = sws.Cells(I, 10)     'Dr
              tws.Cells(CurRw, 15) = sws.Cells(I, 11)     'Cr
              CurRwEnd = CurRw                            'Mark down Ending Row of Import
              CurRw = CurRw + 1
          Next
       End If
    End If

Open in new window


We have add the 3 files modified.  
Open and run macro on 'ConsolidateExcel-Final-EE.xlsm'
After it imports the data, go to ‘ConsolidateExcel-Origin1.xlsx’ and ‘ConsolidateExcel-Origin2.xlsx’) and place an "X" on each line under column "B".
To test that the script read new lines, add additional lines and have the column "B" empty.

Please advice
ConsolidateExcel-Final-EE.xlsm
ConsolidateExcel-Origin1.xlsx
ConsolidateExcel-Origin2.xlsx
0
 
Harry LeeCommented:
1.
Remember the code    strPath = GetFolder("C:\Users\RR\Documents\zzzzNew folder\eeXds\") & "\"?
This is where you set the path of the file. Currently, the line is wrong. The part GetFolder is a custom function to ask for user input to specify the folder. If your data file is located in C:\Users\RR\Documents\zzzzNew folder\eeXds\, the line should be strPath = "C:\Users\RR\Documents\zzzzNew folder\eeXds\"

In order to set two separate paths, you need to add one more variables in the Dim. For example strPath2. Then add a line like strPath2 = "C:\Users\RR\Documents\yyyyNew folder\eeXds\" to point strPath2 to the folder.

I can point out areas that you need to work on to achieve opening two files individually, and give you some explanations.

The following line force you to declare all the variables used in the module.
Option Explicit

Open in new window


The following section is the popup box to get user input regarding where the data files are stored. If you don't want the question box, you can delete this section.
Function GetFolder(InitDir As String) As String
Dim fldr As FileDialog
Dim sItem As String
sItem = InitDir
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)

With fldr
 .Title = "Select a Folder"
 .AllowMultiSelect = False
 If Right(sItem, 1) <> "\" Then
    sItem = sItem & "\"
    End If
 .InitialFileName = sItem
 If .Show <> -1 Then
    sItem = InitDir
   Else
    sItem = .SelectedItems(1)
    End If
End With

GetFolder = sItem
Set fldr = Nothing
End Function

Open in new window


This section declares all the variables used in the procedure. With Option Explicit turned on, it's important to declare all the variables.
You will need to add one or two variables here. strPath2, and strFile2
'   Declare Variables
    Dim strPath As String, strFile As String
    Dim swbk As Workbook, twbk As Workbook
    Dim tws As Worksheet, sws As Worksheet
    Dim twsn As String
    Dim CurRw As Long, I As Long, DataLstRw As Long, DataLstRw2 As Long, CurRwStart As Long, CurRwEnd As Long

Open in new window

   
This section tells Excel which workbook and which sheet is the target; where data will end up on.)
'--------------------------------------------------
'   Set Target Workbook Object Variables Values
    Set twbk = ActiveWorkbook
    
'--------------------------------------------------
'   Use existing sheet POOrderLine as the target sheet
    Set tws = twbk.Sheets("Sheet1")

Open in new window



This is the section you need to modify so that instead of using the GetFolder custom function, you directly set the strPath, strPath2, strFile, and strFile2 to suit your need.
'   Get Data folder from user
    strPath = GetFolder("C:\Users\RR\Documents\zzzzNew folder\eeXds\") & "\"
    strFile = Dir(strPath & "*.xlsx")

Open in new window


Once modified, it should look similar to the following.
   strPath = "C:\Users\RR\Documents\zzzzNew folder\eeXds\"
    strFile = Dir(strPath & "*.xlsx")
    StrPath2 = "C:\Users\RR\Documents\yyyyNew folder\eeXds\"
    strFile2 = Dir(strPath2 & "*.xlsx")

Open in new window


This is where you have to modify to get rid of the loop. Since you are not going to put the data files into one single folder.
'--------------------------------------------------
'   Loop through all files in user specified folder tor workbooks
' HERE OPEN ALL THE FILES

    Do While strFile <> ""
        If Right(strFile, 4) = "xlsx" Then
            Set swbk = Workbooks.Open(Filename:=strPath & strFile)
            Set sws = ActiveSheet
        End If

Open in new window


Instead, you will simple change it to
Set swbk = Workbooks.Open)Filename:=strPath & strFile
Set sws = ActiveSheet

Open in new window


This is where the chorus begin. You will need to duplicate this whole section for the second file.
'   Find the Last Valid Row of Data Detail
    DataLstRw = sws.Cells(Rows.Count, 3).End(xlUp).Row
    If Len(Application.WorksheetFunction.Substitute(sws.Cells(DataLstRw, 3), " ", "")) = 0 Then
        DataLstRw = DataLstRw - 1
    End If
'--------------------------------------------------
'   Loop through all detail lines of Data files and copy onto Master sheet
    DataLstRw2 = sws.Cells(Rows.Count, 2).End(xlUp).Row
    If DataLstRw2 >= 17 Then                              'Only if there is new lines
       If DataLstRw2 <> DataLstRw Then                    'Only if there is new lines
          For I = (DataLstRw2 + 1) To DataLstRw           '18 To DataLstRw
              tws.Cells(CurRw, 7) = sws.Cells(I, 3)       'Date
              tws.Cells(CurRw, 9) = sws.Cells(I, 5)       'Provider
              tws.Cells(CurRw, 10) = sws.Cells(I, 6)      'Ref
              tws.Cells(CurRw, 12) = sws.Cells(I, 8)      'Description
              tws.Cells(CurRw, 14) = sws.Cells(I, 10)     'Dr
              tws.Cells(CurRw, 15) = sws.Cells(I, 11)     'Cr
              CurRwEnd = CurRw                            'Mark down Ending Row of Import
              CurRw = CurRw + 1
          Next
       End If
    End If
            
'--------------------------------------------------
'   Close Data file
    swbk.Close SaveChanges:=False

Open in new window



Delete this since you are no longer running the loop.
'   Resume Loop
         strFile = Dir
    Loop

Open in new window


Next, you need to insert this to open the second file.
Set swbk = Workbooks.Open)Filename:=strPath2 & strFile2
Set sws = ActiveSheet

Open in new window


Then, insert the Chorus next.

Finally, continue with the sort.

'--------------------------------------------------
'   Sort Current Imported Lines
    
'2015-0511, HOLD THIS ROUTINE UNTIL HARRY_LEE SEE THE ENTRIE PROCESS

 '   tws.Sort.SortFields.Clear
 '   tws.Sort.SortFields.Add Key:=Range(Cells(CurRwStart, 10), Cells(CurRwEnd, 10)), _
 '       SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
 '       xlSortTextAsNumbers
 '   With tws.Sort
 '       .SetRange Range(Cells(CurRwStart, 7), Cells(CurRwEnd, 15))
 '      .Header = xlNo
 '      .MatchCase = False
 '       .Orientation = xlTopToBottom
 '       .SortMethod = xlPinYin
 '       .Apply
 '   End With

'--------------------------------------------------
'   Remove Object Varibles from memory

Set twbk = Nothing
Set tws = Nothing
Set sws = Nothing
End Sub

Open in new window


This is a pretty nice project to get to learn VBA a little deeper.
0
 
Harry LeeCommented:
Give it a try.

Let me know if you bump into trouble. Worse of the case, I can alter it for you.
0
 
rayluvsAuthor Commented:
Hey thanx lots!!! Will give it a try when get to the PC!
0
 
rayluvsAuthor Commented:
Thank you very much!  Worked Excellently!!  

We did some modifications and works perfect but wanted, prior closing this question, your observation on some modifications we did:

1.  What does the following lines means?:
     
     If Len(Application.WorksheetFunction.Substitute(sws.Cells(DataLstRw, 3), " ", "")) = 0 Then
        DataLstRw = DataLstRw - 1
        End If

Open in new window


2. We added a a line in order to mark "X" on the line that has been processed.   We included
    the line "sws.Cells(I, 2) = "x"" in the routine in the Chorus area (see line 12 below).  Is this Ok?:
   
'Import the non-processed lines
 If DataLstRw2 >= 17 Then                              'Start after the Heading row
    If DataLstRw2 <> DataLstRw Then                    'Start only there is a REAL next line to import
       For I = (DataLstRw2 + 1) To DataLstRw           '18 To DataLstRw
           tws.Cells(CurRw, 7) = sws.Cells(I, 3)       'Date
           tws.Cells(CurRw, 9) = sws.Cells(I, 5)       'Provider
           tws.Cells(CurRw, 10) = sws.Cells(I, 6)      'Ref
           tws.Cells(CurRw, 12) = sws.Cells(I, 8)      'Description
           tws.Cells(CurRw, 14) = sws.Cells(I, 10)     'Dr
           tws.Cells(CurRw, 15) = sws.Cells(I, 11)     'Cr
          'Marked the Imported line as Processed
           sws.Cells(I, 2) = "x"
           CurRwEnd = CurRw                            'Mark down Ending Row of Import
           CurRw = CurRw + 1
           Next
       End If
    End If

Open in new window


3. We changed where the code closed the source file so it can close by SAVING when an "X" has been
    included as a mark and NOT save when nothing imported.  Is this ok? (see code below)

   
'Close the FIRST import file
 If DataLstRw2 <> DataLstRw Then
    swbk.Close SaveChanges:=True 'SAVE after closing since NEW lines found
   Else
    swbk.Close SaveChanges:=False 'Don't save when closing
    End If

Open in new window


4. And lastly, if we wanted to import more than one sheet of the same import file, just change
    the line "Set sws = ActiveSheet" to "Set tws = twbk.Sheets("Sheet_Name")"?

Please advice.
0
 
Harry LeeCommented:
1.
    DataLstRw = sws.Cells(Rows.Count, 3).End(xlUp).Row
    If Len(Application.WorksheetFunction.Substitute(sws.Cells(DataLstRw, 3), " ", "")) = 0 Then
        DataLstRw = DataLstRw - 1
    End If

Open in new window


These 2 lines have to work together. On the 1st line, Excel finds the last row of data by checking Column C.
Then, the 2nd line checks the result of the 1st line to make sure it's not an empty line. Some software likes to add a "Space" to the first column after the last true data.

So in English, it's like (If the number of characters in DataLstRw, after I ignore all SPACES, is zero, then -1 from DataLstRw.)

2. Looks fine.

3. Don't bother checking between DataLstRw and DataLstRw2. Simply save the file before close. There is nothing else that would change the source data except the Mark X. That cuts one loop from your vba.

4. You are correct on that. Again, if you are importing all the sheets in the same workbook, you can write a loop such as "For Each Sheets in Worksheets......Next".

Otherwise, you will have to duplicate the Chorus again, to cover each of the sheets you want to import from the file.

In that case, you have to be very clear how many sheets from each file you are importing.
0
 
rayluvsAuthor Commented:
Ok, great fully understood, the condition "Len(Application.WorksheetFunction.Substitute(sws.Cells(DataLstRw, 3), " ", ""))" is to check if the entire is empty or not.

Listen Harry_Lee you have been super helpful and very instructive on our  problem.

Thanx a lot!
0
 
rayluvsAuthor Commented:
Thanx!
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.