PDA

View Full Version : Please Help !!! Copy particular columns from one file to master file with condition



siddi20
03-30-2018, 08:07 AM
Please Help!!!
Task is to consolidate 2 files(A and B) into Master file. I have written code below but its tkng all fields.I only want

Column 1 - File Name ( name of A/B)
Column 2- Gender/Value 1 .If Gender is M then it should show Value 1
Else I should show Gender value

Column 3-Value 2
Column 4 - Region value

I have filter the data in A/B files country specific. I will really appreciate if someone can help.

Attaching the files for reference

mana
03-30-2018, 05:33 PM
Option Explicit


Sub test()
Dim a As Object
Dim p As String, f As String
Dim v
Dim i As Long


Set a = CreateObject("system.collections.arraylist")

p = ThisWorkbook.path & "\"
f = Dir(p & "*.xlsx")
Do While f <> ""
With Workbooks.Open(p & f, ReadOnly:=True)
v =.Sheets(1).Cells(1).CurrentRegion.Value
For i = 2 To UBound(v)
a.Add Array(f, IIf(v(i, 3) = "M", v(i, 3), v(i, 4)), v(i, 5), v(i, 6))
Next
.Close
End With
f = Dir()
Loop

With ThisWorkbook.Sheets(1)
.UsedRange.Offset(2).ClearContents
.Cells(3, 1).Resize(a.Count, 4).Value = _
Application.Transpose(Application.Transpose(a.toarray))
End With

End Sub



マナ

siddi20
03-30-2018, 05:49 PM
Thank you Mana.I am really new to VBA.Can you please explain and how to add this in my workbook.

mana
03-31-2018, 02:54 AM
https://www.rondebruin.nl/win/code.htm

siddi20
04-01-2018, 08:22 AM
Thank you so much Mana.You are really very helpful.I just missed one condition that the columns doesnt have same columns .
File A.xsl has Country salary gender value1 value2 Region1 City Price
File B.xsl has Country salary gender value1 value2 University School Grade

Master.xslm should have FileName Gender/Value1 Value 2 Region School Price Grade

Can you please tell me the code for selecting specific columns (as expected in result Master.xslm) and copy pasting accordingly.

I need to submit this today.I will be really greatful if you can help me with this.

mana
04-02-2018, 04:30 AM
Option Explicit


Sub test2()
Dim a As Object
Dim p As String
Dim v
Dim f As String
Dim i As Long
Dim flg As Boolean

Set a = CreateObject("system.collections.arraylist")

p = ThisWorkbook.path & "\"
f = Dir(p & "*.xlsx")

Do While f <> ""
With Workbooks.Open(p & f, ReadOnly:=True)
v = .Sheets(1).Cells(1).CurrentRegion.Value
flg = False
If v(1, 7) = "School" Then flg = True
For i = 2 To UBound(v)
a.Add Array(f, IIf(v(i, 3) = "M", v(i, 3), v(i, 4)), v(i, 5), _
IIf(flg, Empty, v(i, 6)), IIf(flg, v(i, 7), Empty) _
, IIf(flg, Empty, v(i, 8)), IIf(flg, v(i, 8), Empty))
Next
.Close
End With
f = Dir()
Loop

With ThisWorkbook.Sheets(1)
.UsedRange.Offset(2).ClearContents
.Cells(3, 1).Resize(a.Count, 7).Value = _
Application.Transpose(Application.Transpose(a.toarray))
End With

End Sub