PDA

View Full Version : vba import data from another workbook with auto filtered of specified name



elsuji
06-15-2019, 10:21 AM
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
06-16-2019, 02:17 PM
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
06-17-2019, 12:28 PM
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
06-17-2019, 02:30 PM
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
06-17-2019, 08:49 PM
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
06-17-2019, 10:11 PM
Hello elsuji,

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

elsuji
06-18-2019, 12:24 AM
Yes I want like that.

It has to calculate the vales as per the engineer name

elsuji
06-19-2019, 01:54 PM
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