Search

Connect & Query Data to an External Workbook

Option Explicit

Sub query_import_data()
'https://www.youtube.com/watch?v=bXaM2kU4Mzc&feature=youtu.be

'-----------------------------
'Thanks for downloading the code. 
'Please visit our channel for a quick explainer on how to use this code.
'Feel free to update the code as per your need and also share with your friends.
'Download free codes from http://vbaa2z.blogspot.com
'Support our channel: youtube.com/vbaa2z
'Author: L Pamai (vbaa2z.team@gmail.com)
'-----------------------------

    Dim datarng As Range
    Dim lr As Long
    Dim wb As Workbook
    Dim en_likematch As Boolean
    Dim queryResult As Long
    
    Dim cust As String
    Dim pdate As String
    Dim zip As Long
    
    
    Application.ScreenUpdating = False
    
    ThisWorkbook.Activate
    'Sheets("QueryMaster").activate
    Range("E4:R" & Rows.Count).ClearContents
    Range("A1").Select
    
    cust = Sheets("QueryMaster").Range("Customer").Value
    zip = Sheets("QueryMaster").Range("zip").Value
    
    pdate = Sheets("QueryMaster").Range("Transaction_date").Value
    en_likematch = Sheets("QueryMaster").Range("likeMatch").Value
    
    
    Set wb = Workbooks.Open(Filename:="D:\VbaA2z\2019\Data.xlsx", ReadOnly:=True)
    
    wb.Activate
    Sheets("TData").Select
    Sheets("TData").AutoFilterMode = False
    
    lr = Sheets("TData").Range("A" & Rows.Count).End(xlUp).Row
    
    Set datarng = ActiveSheet.Range("$A$1:$N$" & lr)
    
    If cust <> "" Then
        If en_likematch = True Then
        datarng.AutoFilter Field:=1, Criteria1:="=*" & cust & "*", Operator:=xlAnd
        Else
        datarng.AutoFilter Field:=1, Criteria1:="=" & cust
        End If
    End If
    
    
    If zip <> 0 Then
        If en_likematch = True Then
        datarng.AutoFilter Field:=9, Criteria1:="=*" & zip & "*", Operator:=xlAnd
        Else
        datarng.AutoFilter Field:=9, Criteria1:="=" & zip
        End If
    End If
    
    If pdate <> "" Then
        datarng.AutoFilter Field:=12, Operator:=xlFilterValues, Criteria2:=Array(2, pdate)
    End If
    
    queryResult = Range("A1:A" & lr).SpecialCells(xlCellTypeVisible).Count
    
    If queryResult > 1 Then
        Range("A2:N" & lr).SpecialCells(xlCellTypeVisible).Copy
        
        ThisWorkbook.Activate
        Sheets("QueryMaster").Select
        
        Range("E4").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
        
        Range("A1").Select
        
        Application.CutCopyMode = False
    End If
    
    Set datarng = Nothing
    wb.Close False
    Set wb = Nothing
    
    Application.ScreenUpdating = True
    
End Sub

No comments:

Post a Comment

Note: only a member of this blog may post a comment.