We help IT Professionals succeed at work.
Get Started

Import data from one workbook to another

AFGPHXExcel
AFGPHXExcel asked
on
501 Views
Last Modified: 2012-05-11
I have a database that is suppose to import data from spreadsheets submitted. The database goes through two different worksheets in the imported workbook and identifies if the data has changed in a specific row by a change flag, the letter "Y". If the data has changed it is then copied and pasted into the corresponding row in the original database. For some reason, I can get excel to identify the import workbook but it is not recognizing the change flag and therefore not copying and pasting the data I need. The code is as follows:

' Import Data Button
Private Sub CommandButton10_Click()

    With Application
        .DisplayAlerts = False
        .ScreenUpdating = False
    End With

' Browse to open a new excel file
    Dim import_file_location As Variant
        import_file_location = file_open()

If import_file_location = False Then
    Exit Sub
   
ElseIf VBA.InStr(import_file_location, "TF_") = 0 Then
    MsgBox ("Please select a QAR/GTPR Service Tracker to import")
    Exit Sub

Else

    With ThisWorkbook
        ' Get this workbook's name
            Dim full_master_name As String
                full_master_name = .Name
    End With
   
    Dim del_start As Long
    Dim full_import_file_name As String
    Dim import_file_name As String
   
        del_start = VBA.InStrRev(import_file_location, "\")
        del_start = VBA.Len(import_file_location) - del_start
        full_import_file_name = VBA.Right(import_file_location, del_start)
       
        del_start = VBA.InStrRev(full_import_file_name, ".")
        import_file_name = VBA.Left(full_import_file_name, del_start - 1)

    ' Open the new file under the new name
        Dim XL As Excel.Application
        Set XL = New Excel.Application
            XL.Workbooks.Open Filename:=import_file_location
 
    With XL.Workbooks(full_import_file_name)
    .Activate
    ' Find the cells in the Risk and Trend Analysis Tab to Copy over
        With Sheet4
            .Activate
            .Select
            If .AutoFilterMode = True Then
                If .FilterMode = True Then
                    .ShowAllData
                End If
            End If
         
            ' Define import range
                Dim import_header_row As Long
                Dim import_first_row As Long
                Dim import_last_row As Long
                Dim import_first_col As Long
                Dim import_last_col As Long
                    import_header_row = 4
                    import_first_row = import_header_row + 1
                    import_last_row = .UsedRange.Rows.Count
                    import_first_col = 1
                    import_last_col = .UsedRange.Columns.Count
           
                Dim RT_flag As Range
                Dim import_copy_row As Long
                Dim master_paste_row As Long
                    Dim prop_risk_like As String
                    Dim KTR_CARs As String
                    Dim pers_change As String
                    Dim pop_change As String
                    Dim best_practices As String
                    Dim notes_info As String
                        Dim import_site_code As String
                        Dim import_service_type As String
                        Dim import_service_name As String
                        Dim import_sub_loc As String
                            Dim found_site_code As Range
                            Dim found_service_type As String
                            Dim found_service_name As String
                            Dim found_sub_loc As String
                                Dim first_addr As Variant
                                Dim audit_idx As Long
                       
                ' Cycle through the QAR Change Flag column in the Risk and Trend Analysis Tab
                    For Each RT_flag In .Range(.Cells(import_first_row, .Range("RT_change_flag").Column), _
                                               .Cells(import_last_row, .Range("RT_change_flag").Column))
                        If RT_flag = "Y" Then
                           
                            ' Get Row information before finding if it's a Key Service
                                import_copy_row = RT_flag.Row
                               
                            ' Get Risk information to copy over
                                prop_risk_like = .Range(.Cells(import_copy_row, .Range("RT_prop_risk_like").Column), _
                                                        .Cells(import_copy_row, .Range("RT_prop_risk_like").Column)).Value
                                KTR_CARs = .Range(.Cells(import_copy_row, .Range("RT_KTR_CARs").Column), _
                                                  .Cells(import_copy_row, .Range("RT_KTR_CARs").Column)).Value
                                pers_change = .Range(.Cells(import_copy_row, .Range("RT_personnel").Column), _
                                                          .Cells(import_copy_row, .Range("RT_personnel").Column)).Value
                                pop_change = .Range(.Cells(import_copy_row, .Range("RT_population").Column), _
                                                    .Cells(import_copy_row, .Range("RT_population").Column)).Value
                                best_practices = .Range(.Cells(import_copy_row, .Range("RT_KTR_best_prac").Column), _
                                                        .Cells(import_copy_row, .Range("RT_KTR_best_prac").Column)).Value
                                notes_info = .Range(.Cells(import_copy_row, .Range("RT_notes").Column), _
                                                    .Cells(import_copy_row, .Range("RT_notes").Column)).Value
                                                   
                            ' Get row info to perform the find function
                                import_site_code = .Range(.Cells(import_copy_row, .Range("RT_site_number").Column), _
                                                          .Cells(import_copy_row, .Range("RT_site_number").Column)).Value
                                import_service_type = .Range(.Cells(import_copy_row, .Range("RT_service_type").Column), _
                                                             .Cells(import_copy_row, .Range("RT_service_type").Column)).Value
                                import_service_name = .Range(.Cells(import_copy_row, .Range("RT_service").Column), _
                                                             .Cells(import_copy_row, .Range("RT_service").Column)).Value
                                import_sub_loc = .Range(.Cells(import_copy_row, .Range("RT_sub_loc").Column), _
                                                        .Cells(import_copy_row, .Range("RT_sub_loc").Column)).Value
                                                 
                            ' Find the same row in the Master workbook
                                With Workbooks(full_master_name)
                                    With Sheet4
                                        If .FilterMode = True Then
                                            .ShowAllData
                                        End If
                                       
                                        Set found_site_code = .Range("RT_site_number").Find(What:=import_site_code, _
                                                                                        LookIn:=xlFormulas, _
                                                                                        Lookat:=xlWhole, _
                                                                                        SearchOrder:=xlByRows, _
                                                                                        SearchDirection:=xlNext, _
                                                                                        SearchFormat:=False, _
                                                                                        MatchCase:=False)
                                           
                                            ' Get the address of the first found site to keep from infinite looping
                                                If Not found_site_code Is Nothing Then
                                                    first_addr = found_site_code.Address
                                                End If
                                               
                                                    audit_idx = 0
                                                Do Until audit_idx = 1 Or audit_idx = 2
                                                       
                                                    If found_site_code Is Nothing Then
                                                        audit_idx = 2
                                                    End If
                                                   
                                                    ' Get found row info and found row values
                                                        master_paste_row = found_site_code.Row
                                                       
                                                        found_service_type = .Range(.Cells(master_paste_row, .Range("RT_service_type").Column), _
                                                                                    .Cells(master_paste_row, .Range("RT_service_type").Column)).Value
                                                        found_service_name = .Range(.Cells(master_paste_row, .Range("RT_service").Column), _
                                                                                    .Cells(master_paste_row, .Range("RT_service").Column)).Value
                                                        found_sub_loc = .Range(.Cells(master_paste_row, .Range("RT_sub_loc").Column), _
                                                                               .Cells(master_paste_row, .Range("RT_sub_loc").Column)).Value
                               
                                                    ' Stop when all found values equal the search values
                                                        If found_service_type = import_service_type And found_service_name = import_service_name _
                                                                        And found_sub_loc = import_sub_loc Or found_site_code.Address = first_addr Then
                                                            audit_idx = 1
                                                        End If
                                         
                                                    Set found_site_code = .Range("RT_site_number").FindNext(found_site_code)
                                               
                                                Loop
                                   
                                                ' Copy the information over to the Risk & Trend Analysis Tab when a match is found
                                                    If audit_idx = 1 Then
                                                        .Range(.Cells(master_paste_row, .Range("RT_prop_risk_like").Column), _
                                                               .Cells(master_paste_row, .Range("RT_prop_risk_like").Column)).Value = prop_risk_like
                                                        .Range(.Cells(master_paste_row, .Range("RT_KTR_CARs").Column), _
                                                               .Cells(master_paste_row, .Range("RT_KTR_CARs").Column)).Value = KTR_CARs
                                                        .Range(.Cells(master_paste_row, .Range("RT_personnel").Column), _
                                                               .Cells(master_paste_row, .Range("RT_personnel").Column)).Value = pers_change
                                                        .Range(.Cells(master_paste_row, .Range("RT_population").Column), _
                                                               .Cells(master_paste_row, .Range("RT_population").Column)).Value = pop_change
                                                        .Range(.Cells(master_paste_row, .Range("RT_KTR_best_prac").Column), _
                                                               .Cells(master_paste_row, .Range("RT_KTR_best_prac").Column)).Value = best_practices
                                                        .Range(.Cells(master_paste_row, .Range("RT_notes").Column), _
                                                               .Cells(master_paste_row, .Range("RT_notes").Column)).Value = notes_info
                                                    End If
                                   
                                    End With
                                End With
                        End If
                   
                    Next RT_flag
        End With
   
    ' Find the cells to copy over from the "Service Tracker Tab"
        With Sheet2
            .Activate
            If .FilterMode = True Then
                .ShowAllData
            End If
           
            ' Cycle through the QAR Change Flag column in the Service tracker Tab
                Dim ST_flag As Range
                Dim PCOR_name As String
                Dim PCOR_redeploy As String
                Dim PCOR_email As String
                Dim current_QAR As String
                Dim next_QAR As String
                    Dim import_surv_type As String
                    Dim import_audit_type As String
                    Dim found_surv_type As String
                    Dim found_audit_type As String
                   
                    import_first_row = 3
                    import_last_row = .UsedRange.Rows.Count
                    import_last_col = .UsedRange.Columns.Count
                   
                    For Each ST_flag In .Range(.Cells(import_first_row, .Range("ST_change_flag").Column), _
                                               .Cells(import_last_row, .Range("ST_change_flag").Column))
                        If ST_flag = "Y" Then
                           
                            ' Get Row information before finding if it's a Key Service
                                import_copy_row = ST_flag.Row
                               
                            ' Get QAR and COR information to copy over
                                PCOR_name = .Range(.Cells(import_copy_row, .Range("ST_PCOR_name").Column), _
                                                   .Cells(import_copy_row, .Range("ST_PCOR_name").Column)).Value
                                PCOR_redeploy = .Range(.Cells(import_copy_row, .Range("ST_PCOR_R_R").Column), _
                                                       .Cells(import_copy_row, .Range("ST_PCOR_R_R").Column)).Value
                                PCOR_email = .Range(.Cells(import_copy_row, .Range("ST_PCOR_email").Column), _
                                                    .Cells(import_copy_row, .Range("ST_PCOR_email").Column)).Value
                                current_QAR = .Range(.Cells(import_copy_row, .Range("ST_current_QAR").Column), _
                                                     .Cells(import_copy_row, .Range("ST_current_QAR").Column)).Value
                                next_QAR = .Range(.Cells(import_copy_row, .Range("ST_next_QAR").Column), _
                                                  .Cells(import_copy_row, .Range("ST_next_QAR").Column)).Value
                                                   
                            ' Get row info to perform the find function
                                import_surv_type = .Range(.Cells(import_copy_row, .Range("ST_surv_type").Column), _
                                                          .Cells(import_copy_row, .Range("ST_surv_type").Column)).Value
                                import_audit_type = .Range(.Cells(import_copy_row, .Range("ST_audit_type").Column), _
                                                           .Cells(import_copy_row, .Range("ST_audit_type").Column)).Value
                                import_site_code = .Range(.Cells(import_copy_row, .Range("ST_site_number").Column), _
                                                          .Cells(import_copy_row, .Range("ST_site_number").Column)).Value
                                import_service_type = .Range(.Cells(import_copy_row, .Range("ST_service_type").Column), _
                                                             .Cells(import_copy_row, .Range("ST_service_type").Column)).Value
                                import_service_name = .Range(.Cells(import_copy_row, .Range("ST_service").Column), _
                                                             .Cells(import_copy_row, .Range("ST_service").Column)).Value
                                import_sub_loc = .Range(.Cells(import_copy_row, .Range("ST_sub_loc").Column), _
                                                        .Cells(import_copy_row, .Range("ST_sub_loc").Column)).Value
                                                 
                            ' Find the same row in the Master workbook
                                With Workbooks(full_master_name)
                                    With Sheet2
                                        .Activate
                                        If .FilterMode = True Then
                                            .ShowAllData
                                        End If
                                       
                                        Set found_site_code = .Range("ST_site_number").Find(What:=import_site_code, _
                                                                                        LookIn:=xlFormulas, _
                                                                                        Lookat:=xlWhole, _
                                                                                        SearchOrder:=xlByRows, _
                                                                                        SearchDirection:=xlNext, _
                                                                                        SearchFormat:=False, _
                                                                                        MatchCase:=False)
                                           
                                            ' Get the address of the first found site to keep from infinite looping
                                                If Not found_site_code Is Nothing Then
                                                    first_addr = found_site_code.Address
                                                End If
                                               
                                                    audit_idx = 0
                                                Do Until audit_idx = 1 Or audit_idx = 2
                                                   
                                                    If found_site_code Is Nothing Then
                                                        audit_idx = 2
                                                    End If
                                                   
                                                    ' Get found row info and found row values
                                                        master_paste_row = found_site_code.Row
                                                       
                                                        found_surv_type = .Range(.Cells(master_paste_row, .Range("ST_surv_type").Column), _
                                                                                 .Cells(master_paste_row, .Range("ST_surv_type").Column)).Value
                                                        found_audit_type = .Range(.Cells(master_paste_row, .Range("ST_audit_type").Column), _
                                                                                  .Cells(master_paste_row, .Range("ST_audit_type").Column)).Value
                                                        found_service_type = .Range(.Cells(master_paste_row, .Range("ST_service_type").Column), _
                                                                                    .Cells(master_paste_row, .Range("ST_service_type").Column)).Value
                                                        found_service_name = .Range(.Cells(master_paste_row, .Range("ST_service").Column), _
                                                                                    .Cells(master_paste_row, .Range("ST_service").Column)).Value
                                                        found_sub_loc = .Range(.Cells(master_paste_row, .Range("ST_sub_loc").Column), _
                                                                               .Cells(master_paste_row, .Range("ST_sub_loc").Column)).Value
                               
                                                    ' Stop when all found values equal the search values
                                                        If found_service_type = import_service_type And found_service_name = import_service_name _
                                                                        And found_sub_loc = import_sub_loc And found_surv_type = import_surv_type _
                                                                        And found_audit_type = import_audit_type Or found_site_code.Address = first_addr Then
                                                            audit_idx = 1
                                                        End If
                                         
                                                    Set found_site_code = .Range("ST_site_number").FindNext(found_site_code)
                                               
                                                Loop
                                   
                                                ' Copy the information over to the Risk & Trend Analysis Tab when a match is found
                                                    If audit_idx = 1 Then
                                                        .Range(.Cells(master_paste_row, .Range("ST_PCOR_name").Column), _
                                                               .Cells(master_paste_row, .Range("ST_PCOR_name").Column)).Value = PCOR_name
                                                        .Range(.Cells(master_paste_row, .Range("ST_PCOR_R_R").Column), _
                                                               .Cells(master_paste_row, .Range("ST_PCOR_R_R").Column)).Value = PCOR_redeploy
                                                        .Range(.Cells(master_paste_row, .Range("ST_PCOR_email").Column), _
                                                               .Cells(master_paste_row, .Range("ST_PCOR_email").Column)).Value = PCOR_email
                                                        .Range(.Cells(master_paste_row, .Range("ST_current_QAR").Column), _
                                                               .Cells(master_paste_row, .Range("ST_current_QAR").Column)).Value = current_QAR
                                                        .Range(.Cells(master_paste_row, .Range("ST_next_QAR").Column), _
                                                               .Cells(master_paste_row, .Range("ST_next_QAR").Column)).Value = next_QAR
                                                       
                                                    End If
                                   
                                    End With
                                End With
                        End If
                   
                    Next ST_flag
        End With
   
        With Sheet4
            .Activate
        End With
       
    .Close
    End With

    MsgBox ("All QAR/GTPR data has been imported")
   
End If

' Turn application alerts back on
    With Application
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With

End Sub

Any help would be much appreciated! Thanks!
Comment
Watch Question
CERTIFIED EXPERT
Commented:
This problem has been solved!
Unlock 1 Answer and 34 Comments.
See Answer
Why Experts Exchange?

Experts Exchange always has the answer, or at the least points me in the correct direction! It is like having another employee that is extremely experienced.

Jim Murphy
Programmer at Smart IT Solutions

When asked, what has been your best career decision?

Deciding to stick with EE.

Mohamed Asif
Technical Department Head

Being involved with EE helped me to grow personally and professionally.

Carl Webster
CTP, Sr Infrastructure Consultant
Ask ANY Question

Connect with Certified Experts to gain insight and support on specific technology challenges including:

  • Troubleshooting
  • Research
  • Professional Opinions
Did You Know?

We've partnered with two important charities to provide clean water and computer science education to those who need it most. READ MORE