copy pasting multiple columns from multiple workbooks into one master workbook

[mogss_04]

Hi can you let me know how to code the below,

I have 3 files named Belarus, Belarus2 and Belarus3 and i need to paste the the below from each of the files into master file.Would it be possible to execute all at once. I have all the files saved in the folder in the path "C:\Users\Priyanka Singh\Desktop\VBA code"

Belarus file to master file
1. "Country" column from Belarus to "Country" in masterfile
2. "Material " column from Belarus to "ITEM_CODE" in master file
3. "Material Name" column from Belarus to "ITEM_DESCR" in master file
4. "Batch" column from Belarus to "LOT_NO" in master file
5. "Manufacturing Date" column from Belarus to "MFG_DATE"
6. "Batch Expiry Date" column from Belarus to "EXP_DATE" in master file
7. "Total Qty column" from Belarus to "QUANTITY" in master file

Belarus2 file to master file
1. "Country" column from Belarus2 to "Country" in masterfile
2. "HANA Code" column from Belarus2 to "ITEM_CODE" in masterfile
3. "Product Name" column from Belarus2 to "ITEM_DESCR" in masterfile
4. "Total Stock Qty" column from Belarus2 to "QUANTITY" in masterfile

Belarus3 file to master file
1. "Country" column from Belarus3 to "Country" in masterfile
2. "Material Code " column from Belarus3 to "ITEM_CODE" in master file
3. "Material " column from Belarus3 to "ITEM_DESCR" in master file
4. "Usage " column from Belarus3 to "Inventory Flag" in master file
5. "Batch Creation Date" column from Belarus3 to "MFG_DATE"
6. "Batch Expiry Date" column from Belarus3 to "EXP_DATE" in master file
7. "Qty Sales Unit (derived from base unit & product description)" column from Belarus3 to "QUANTITY" in master file

Thank you.

 

[mumps]

Check the "Item Code" header in all your files including the "MW Stock" file. I noticed that there may be 2 spaces between the word "Item" and the word "Code". If there are 2 spaces, remove one of them. In this manner they will all match up. Try:

Sub copyColumns()
    Application.ScreenUpdating = False
    Dim desWS As Worksheet, srcWB As Workbook, srcWS As Worksheet, x As Long, i As Long, LastRow As Long, LastRow2 As Long, rDate As Range
    Set desWS = ThisWorkbook.Sheets("MW Final")
    Const strPath As String = "C:\Users\Priyanka Singh\Desktop\May - Inventory Automation\MW\"
    ChDir strPath
    strExtension = Dir(strPath & "*.xlsx")
    Do While strExtension <> ""
        Set srcWB = Workbooks.Open(strPath & strExtension)
         Set srcWS = Sheets("Master data")
            LastRow = srcWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            With desWS.Range("A:A,B:B,C:C,D:D,E:E,F:F,G:G")
                LastRow2 = desWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
                For i = 1 To .Areas.Count
                    x = .Areas(i).Column
                    Set Header = srcWS.Rows(1).Find(.Areas(i).Cells(1), LookIn:=xlValues, lookat:=xlWhole)
                    If Not Header Is Nothing Then
                        srcWS.Range(srcWS.Cells(2, Header.Column), srcWS.Cells(LastRow, Header.Column)).Copy desWS.Cells(LastRow2, x)
                    End If
                Next i
            End With
            srcWB.Close False
        strExtension = Dir
    Loop
    Application.ScreenUpdating = True
End Sub

Both this macro and the previous one I posted will accommodate any blank cells and also if the headers don't exist in any of the source files.

 

[mogss_04]

Hi Mumps,

As usual the problem still persists where the column " D:D" & "E:E" which are "Salable Stock" and "Salable Stock with Distributor Qty" are not getting copy pasted into the master file from source files. Can you please look into it

 

[mogss_04]

Also on the date range, i noticed another issue when i tried it on a different file,all the expiry date falling on "01.06.2020" to be populated as "Usable (>12)" and "01.05.2019" to be populated as "Usable (7-12)" are not getting populated in column N.

 

[mogss_04]

thank you so much for all your time and efforts for looking into above

 

[mumps]

For the "Salable Stock" and "Salable Stock with Distributor Qty" problem, replace this line of code:

Set Header = srcWS.Rows(1).Find(.Areas(i).Cells(1), LookIn:=xlValues, lookat:=xlWhole)

with this one:

Set Header = srcWS.Rows(1).Find(.Areas(i).Cells(1), LookIn:=xlValues, lookat:=xlPart)

For the "date" problem, try:

Sub copyColumns()
    Application.ScreenUpdating = False
    Dim desWS As Worksheet, srcWB As Workbook, srcWS As Worksheet, x As Long, i As Long, LastRow As Long, LastRow2 As Long, rDate As Range
    Set desWS = ThisWorkbook.Sheets("Base inv data")
    'Const strPath As String = "C:\Users\Priyanka Singh\Desktop\VBA code1\"
    Const strPath As String = "C:\Forum Help\mogss\"
    ChDir strPath
    strExtension = Dir(strPath & "*.xlsx")
    Do While strExtension <> ""
        Set srcWB = Workbooks.Open(strPath & strExtension)
        If srcWB.Name = "Belarus 3.xlsx" Then
            Set srcWS = Sheets("base")
            LastRow = srcWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            With desWS.Range("C:C,E:E,F:F,J:J,K:K")
                For i = 1 To .Areas.Count
                    LastRow2 = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
                    x = .Areas(i).Column
                    Set Header = srcWS.Rows(1).Find(.Areas(i).Cells(1), LookIn:=xlValues, lookat:=xlWhole)
                    If Not Header Is Nothing Then
                        srcWS.Range(srcWS.Cells(2, Header.Column), srcWS.Cells(LastRow, Header.Column)).Copy desWS.Cells(LastRow2, x)
                    End If
                Next i
            End With
            With srcWS
                .Range("B1:N" & LastRow).AutoFilter Field:=8, Criteria1:="=Unrestricted Use", Operator:=xlOr, Criteria2:="=Unrestricted-Use Mat"
                For Each rDate In .Range("M2:M" & LastRow).SpecialCells(xlCellTypeVisible)
                    If rDate.Value >= DateSerial(Year(Date) + 1, Month(Date) + 1, 1) Then
                        rDate.Offset(0, 1) = "Usable (>12)"
                    ElseIf rDate.Value >= DateSerial(Year(Date), Month(Date) + 7, 1) And rDate.Value < DateSerial(Year(Date) + 1, Month(Date) + 1, 1) Then
                        rDate.Offset(0, 1) = "Usable (7-12)"
                    ElseIf rDate.Value >= DateSerial(Year(Date), Month(Date), 1) And rDate.Value < DateSerial(Year(Date), Month(Date) + 7, 1) Then
                        rDate.Offset(0, 1) = "Near expiry"
                    ElseIf rDate.Value < DateSerial(Year(Date), Month(Date), 1) Then
                        rDate.Offset(0, 1) = "Expired"
                    End If
                Next rDate
                .Range("B1:N" & LastRow).AutoFilter Field:=8, Criteria1:="Blocked Stock", Operator:=xlOr, Criteria2:="Valuated Goods Receipt Blocked Stock"
                .Range("N2:N" & LastRow).SpecialCells(xlCellTypeVisible) = "Blocked"
                .Range("B1:N" & LastRow).AutoFilter Field:=8, Criteria1:="Transit", Operator:=xlOr, Criteria2:="Intransit"
                .Range("N2:N" & LastRow).SpecialCells(xlCellTypeVisible) = "Transit"
                .Range("B1:N" & LastRow).AutoFilter Field:=8, Criteria1:="Quality inspection"
                .Range("N2:N" & LastRow).SpecialCells(xlCellTypeVisible) = "Quality inspection"
                .Range("B1:N" & LastRow).AutoFilter Field:=8, Criteria1:="Restricted-Use"
                .Range("N2:N" & LastRow).SpecialCells(xlCellTypeVisible) = "Restricted"
                .Range("B1").AutoFilter
                srcWB.Close True
            End With
        Else
            Set srcWS = Sheets("base")
            LastRow = srcWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            With desWS.Range("C:C,E:E,F:F,J:J,K:K")
                For i = 1 To .Areas.Count
                    LastRow2 = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
                    x = .Areas(i).Column
                    Set Header = srcWS.Rows(1).Find(.Areas(i).Cells(1), LookIn:=xlValues, lookat:=xlWhole)
                    If Not Header Is Nothing Then
                        srcWS.Range(srcWS.Cells(2, Header.Column), srcWS.Cells(LastRow, Header.Column)).Copy desWS.Cells(LastRow2, x)
                    End If
                Next i
            End With
            srcWB.Close False
        End If
        strExtension = Dir
    Loop
    Application.ScreenUpdating = True
End Sub

Please note that "01.05.2019" should return "Near Expiry" as you originally requested not "Usable (7-12)" as you said in Post #33.

 

[mogss_04]

Hi Mumps,

It works . Also thanks for pointing out on the expiry date part. Thank you so much for your help and efforts. I would require your help on 3 more parts of my project .

Firstly I learnt about another criteria other day that When "expiry date" is blank or # we need to look at the "Manufacturing Date" column which is column "J" and the same rules apply. Exactly the same as expiry date rules except this goes 1 year back.

which is June 2018 onwards - Usable (>12)
Dec 2017 - May 2018 - Usable (7-12)
May 2017- Nov 2017 - Near Expiry
Before May 2017 -


If Manufacturing date and expiry date both are blanks or # present in both then N column should be poulated as Usable > 12.

2nd part
My next region file involves the below. I will send you the file across for refrence.


path : "C:\Users\Priyanka Singh\Desktop\VBA code1"


https://www.dropbox.com/s/437b14jhqd8vw7c/West.xlsm?dl=0




First we need to look at Column H - Expired Qty column. Unfilter "0" qty. Then look at "Batch Expiry Date" .



1)December 2019 onwards- Coulmn W should be populated as "Expired" and Column X to be populated as "Restricted"


2)May 2019 - November 2019 - Coulmn W should be populated as "Expired" and Column X to be populated as "Near Expiry"


3)anything before May 2019 - Coulmn W should be populated as "Expired" and Column X to be populated as "Expired"


Next look at column J- Near Expiry Qty. Unfilter "0" qty. For all these quantities Coulmn W should be populated as "Near Expiry" and Column X to be populated as "Near Expiry"


Next look at column N - NET Qty. Unfilter "0" qty.


1. June 2020 onwards - Usable (>12)


2. Dec 2019 - May 2020 - Usable (7-12)


And then same "When "expiry date" is blank or # we need to look at the MFG date and the same rules apply. Exactly the same as expiry date rules except this goes 1 year back.


which is June 2018 onwards - Usable (>12)
Dec 2017 - May 2018 - Usable (7-12)
May 2017- Nov 2017 - Near Expiry
Before May 2017 -


If Manufacturing date and expiry date both are blanks or # present in both then W - Usable and Column X column should be poulated as Usable > 12 "


My 3rd part i will let you know once i have more clarity.

thank you so much once again.

 

[mumps]

Column J in the Belarus files doesn't contain a date. Is the "Manufacturing Date" the "Batch Creation Date"? We have been working with different macros for different files. Please be specific as to which file you are referring to.

 

[mumps]

Also, in your description of what you want in columns W and X, you want them populated based on 4 criteria, columns H, J, N and F. Do you want the filtering done in the order that you described?

 

[mogss_04]

Hi Mumps,

You are right. sorry about the file part. Column F in Belarus file called "Batch Creation date" and Column L in Belarus 3 file called "Batch Creation Date". they mean Manufacturing date.

 

[mogss_04]

Yes they need to be populated based on those 4 criterias and also the batch expiry date which is column G. Need to look at that first before manufacturing date which is column F. Yes the filtering needs to be done in the order said above.

Thank you.