Matching Specific Rows and Copy to specific colums.

falak · May 2nd 2020

Hi.

Im stuck with a very minor error with the following code.

What i basically want is every OrderNumber in file i.e "Masterfile" ColumnG should get matched with cell of each value in Column Cof file "POD" and for that respective value its Exclusion value in ColumnE (POD filde) should be copied to ColumnL of "Masterfile".

Example: for OrderNumber "9207116072" in A5 of Masterfile should be macthed with the ordernumber in POD irrespective in which row its found in POD file, after its matched and its found to be in C9 of ColumnC (POD) so its respective exclusion value 2 should be paste in L5 of Masterfile

The code as the moment is pasting the POD date ColumnD of POD instead of ColumnE of POD i have attached both the files for reference.

To use exclusion click Upload Exclusions

Code

Sub uploadPODdataexclusions()
Dim WScopy As Worksheet, WSdest As Worksheet, desWB As Workbook, FileToOpen As Variant, RngList As Object, key As Variant
Dim DRow As Long, cRow As Long, lastRow As Long, fnd As Range, PO As Range, sAddr As String, arr As Variant, i As Long, j As Long
Set desWB = ThisWorkbook
Set WSdest = desWB.Sheets(1)
lastRow = WSdest.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).row
Application.ScreenUpdating = False
FileToOpen = Application.GetOpenFilename(Title:="Browse for your file & Import Range", FileFilter:="Excel Files (*.xls*),*xls*")
If FileToOpen = False Then Exit Sub
Set OpenBook = Application.Workbooks.Open(FileToOpen)
With Sheets(1)
DRow = .Cells(.Rows.Count, "C").End(xlUp).row
arr = .Range("C5:C" & DRow).Resize(, 2).Value
Set RngList = CreateObject("Scripting.Dictionary")
For i = LBound(arr) To UBound(arr)
If Not RngList.Exists(arr(i, 1)) Then
RngList.Add key:=arr(i, 1), Item:=arr(i, 2)
With WSdest.Cells(5, 1).CurrentRegion
.AutoFilter 7, arr(i, 1)
End With
With WSdest
.Range("L5:L" & lastRow).SpecialCells(xlCellTypeVisible) = RngList(arr(i, 1))
End With
End If
Next i
WSdest.Range("A5").AutoFilter
End With
Application.ScreenUpdating = True
ActiveWorkbook.Close False
Application.CutCopyMode = False
End Sub

Display More

Mumps · May 3rd 2020

Try:

Code

Sub uploadPODdataexclusions()
Dim WScopy As Worksheet, WSdest As Worksheet, desWB As Workbook, FileToOpen As Variant, RngList As Object, key As Variant
Dim DRow As Long, cRow As Long, lastRow As Long, fnd As Range, PO As Range, sAddr As String, arr As Variant, i As Long, j As Long
Set desWB = ThisWorkbook
Set WSdest = desWB.Sheets(1)
lastRow = WSdest.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).row
Application.ScreenUpdating = False
FileToOpen = Application.GetOpenFilename(Title:="Browse for your file & Import Range", FileFilter:="Excel Files (*.xls*),*xls*")
If FileToOpen = False Then Exit Sub
Set OpenBook = Application.Workbooks.Open(FileToOpen)
With Sheets(1)
DRow = .Cells(.Rows.Count, "C").End(xlUp).row
arr = .Range("C5:C" & DRow).Resize(, 3).Value
Set RngList = CreateObject("Scripting.Dictionary")
For i = LBound(arr) To UBound(arr)
If Not RngList.Exists(arr(i, 1)) Then
RngList.Add key:=arr(i, 1), Item:=arr(i, 3)
With WSdest.Cells(5, 1).CurrentRegion
.AutoFilter 7, arr(i, 1)
End With
With WSdest
.Range("L5:L" & lastRow).SpecialCells(xlCellTypeVisible) = arr(i, 3)
End With
End If
Next i
WSdest.Range("A5").AutoFilter
End With
Application.ScreenUpdating = True
ActiveWorkbook.Close False
Application.CutCopyMode = False
End Sub

Display More

Matching Specific Rows and Copy to specific colums.

rory May 4th 2020

Share

Tags