Consulting

Results 1 to 8 of 8

Thread: vba import data from another workbook with auto filtered of specified name

  1. #1
    VBAX Regular
    Joined
    Jun 2019
    Posts
    59
    Location

    vba import data from another workbook with auto filtered of specified name

    Hi every one,

    I am new on this forum.

    I have two excel files. one is "Consolidated History.xlsx" and other on is "Test.xlsx"

    I created one command button on Test.xlsx and type the name (Senthil Kumar P) in cell "C2".when i press the command button from Test.xlsx it needs to copy the row's from "Consolidated History.xlsx" (sheet is Consolidated History) as per the name entered in Test.xlsx C2 and paste to "Test.xlsx" Sheet!1 A150.

    Both the excel files attached here.


    Anyone please send me the code for the above condition
    Attached Files Attached Files

  2. #2
    VBAX Expert Leith Ross's Avatar
    Joined
    Oct 2012
    Location
    San Francisco, California
    Posts
    518
    Location
    Hello elsuji,

    This worked for me.

    Private Sub CommandButton1_Click()
    
    
        Dim Area    As Variant
        Dim DstWkb  As Workbook
        Dim DstRng  As Range
        Dim DstWks  As Worksheet
        Dim row     As Long
        Dim Rng     As Range
        Dim SrcWkb  As Workbook
        Dim SrcRng  As Range
        Dim SrcWks  As Worksheet
        
        
            Set DstWkb = ThisWorkbook
            Set DstWks = DstWkb.Worksheets("Test")
            Set DstRng = DstWks.Range("A150")
            
            On Error Resume Next
                Set SrcWkb = Workbooks("Consolidated History.xlsx")
                If Err <> 0 Then
                    MsgBox "Please Open the workbook ""Consolidated History.xlsx""", vbCritical
                    Exit Sub
                End If
                Set SrcWks = SrcWkb.Worksheets("Consolidated History")
                Set SrcRng = SrcWks.Range("A1").CurrentRegion
            On Error GoTo 0
            
                With SrcWks
                    .AutoFilterMode = False
                    .UsedRange.AutoFilter Field:=4, Criteria1:=DstWks.Range("C2").Value, VisibleDropDown:=True
                End With
                
                Set Rng = SrcWks.UsedRange.SpecialCells(xlCellTypeVisible)
                
                For Each Area In Rng.Areas
                    For row = 1 To Area.Rows.Count
                        Area.Copy DstRng
                        Set DstRng = DstRng.Offset(Area.Rows.Count, 0)
                    Next row
                Next Area
                   
    End Sub
    Sincerely,
    Leith Ross

  3. #3
    VBAX Regular
    Joined
    Jun 2019
    Posts
    59
    Location
    Hi Leith Ross

    Thanks for your reply. Your program it is working well.

    I have one more query.

    Once I copy the data's if suppose i change the name, it should delete the old records and replace the new records. All my old name has to erase and the new name should be display.

    How to do this

  4. #4
    VBAX Expert Leith Ross's Avatar
    Joined
    Oct 2012
    Location
    San Francisco, California
    Posts
    518
    Location
    Hello elsuji,

    Just need to add on line. It is marked in bold.

    Private Sub CommandButton1_Click()
    
    
        Dim Area    As Variant
        Dim DstWkb  As Workbook
        Dim DstRng  As Range
        Dim DstWks  As Worksheet
        Dim row     As Long
        Dim Rng     As Range
        Dim SrcWkb  As Workbook
        Dim SrcRng  As Range
        Dim SrcWks  As Worksheet
        
        
            Set DstWkb = ThisWorkbook
            Set DstWks = DstWkb.Worksheets("Test")
            Set DstRng = DstWks.Range("A150")
            
            On Error Resume Next
                Set SrcWkb = Workbooks("Consolidated History.xlsx")
                If Err <> 0 Then
                    MsgBox "Please Open the workbook ""Consolidated History.xlsx""", vbCritical
                    Exit Sub
                End If
                Set SrcWks = SrcWkb.Worksheets("Consolidated History")
                Set SrcRng = SrcWks.Range("A1").CurrentRegion
            On Error GoTo 0
            
                With SrcWks
                    .AutoFilterMode = False
                    .UsedRange.AutoFilter Field:=4, Criteria1:=DstWks.Range("C2").Value, VisibleDropDown:=True
                End With
                
                Set Rng = SrcWks.UsedRange.SpecialCells(xlCellTypeVisible)
                
                DstRng.CurrentRegion.Clear
                
                For Each Area In Rng.Areas
                    For row = 1 To Area.Rows.Count
                        Area.Copy DstRng
                        Set DstRng = DstRng.Offset(Area.Rows.Count, 0)
                    Next row
                Next Area
                   
    End Sub
    Sincerely,
    Leith Ross

  5. #5
    VBAX Regular
    Joined
    Jun 2019
    Posts
    59
    Location
    Dear Leith Ros

    DstRng.CurrentRegion.Clear is working fine.

    But when i upload the data's multiple rows are updating for some peoples.

    Example

    "Senthil Kumar P" the date 11-May-19 is updating multiple times
    "V Jayaprakash" the date 211-May-19 is updating multiple times

    How to avoid the multiple roe entry

    Because of this multiple entry my calculation is problem. i am using the following =SUMIFS(Test!J151:J497,Test!K151:K497,"<>Leave",Test!K151:K497,"<>Holiday") and update the result to Cell "Test!B4"

    Is there any possibility to include this formula on the program

  6. #6
    VBAX Expert Leith Ross's Avatar
    Joined
    Oct 2012
    Location
    San Francisco, California
    Posts
    518
    Location
    Hello elsuji,

    Do you want only the unique call numbers for each engineer's name? I can modify the macro to do that.
    Sincerely,
    Leith Ross

  7. #7
    VBAX Regular
    Joined
    Jun 2019
    Posts
    59
    Location
    Yes I want like that.

    It has to calculate the vales as per the engineer name
    Last edited by elsuji; 06-18-2019 at 05:06 AM.

  8. #8
    VBAX Regular
    Joined
    Jun 2019
    Posts
    59
    Location
    Dear Leith Ross,

    My duplicate row updating problem is rectified.

    I added the following

    Dim r As Range
    Dim n As Long, i As Long
    Dim col

    Set r = Range("A150:Q250")
    n = r.Columns.Count - 1
    ReDim col(0 To n)

    For i = 0 To n
    col(i) = i + 1
    Next
    r.RemoveDuplicates Columns:=CVar(col), Header:=xlNo

    Now there is no duplicate rows are updating while copying from other.

    I have on more queary,

    =SUMIFS(Jan!J151:J453,Jan!K151:K453,"<>Leave",Jan!K151:K453,"<>Holiday") --> This formula to be update in B19 after calculating

    =COUNTIFS(Jan!K151:K461,"<>Leave",Jan!K151:K461,"<>Holiday",Jan!K151:K461," <>General",Jan!K151:K461,"<>Office/Idle",Jan!K151:K461,"<>Other",Jan!K151:K461,"<>Internal Training",Jan!K151:K461,"<>Travel",Jan!K151:K461,"<>Site Training",Jan!K151:K461,"<>") --> This formula to be update in B20 after calculating

    Can you please help me how to include these formulas on my program instead of putting these to cell

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •