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

[elsuji]

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

[Leith Ross]

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

[elsuji]

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

[Leith Ross]

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

[elsuji]

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

[Leith Ross]

Hello elsuji,

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

[elsuji]

Yes I want like that.

It has to calculate the vales as per the engineer name

[elsuji]

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