Elliottj2121
Board Regular
- Joined
- Apr 15, 2021
- Messages
- 50
- Office Version
- 365
- 2019
- Platform
- Windows
Hello I am wondering if someone could help me filter and merge two data sets. I have an ongoing workbook that I add data to every week from a different workbook. I have written some code already to copy the data from one workbook to the working workbook and format it the way I want it. However, I don't know how to further format, filter and merge the two data sets. I attached screenshots of what I am trying to do. I am looking for additional coding to have it look in column C and if two values match copy the corresponding value in columns A and E.
[/CODE]
[/CODE]
The first image below is how my data looks with the code above. The first two rows are old data and the remaining rows are the new data. The second image is how I would like it to look. Basically copying any data in columns A and E from the old data set and paste it into the new data set if there is a duplicate value in column C.
VBA Code:
Sub MasterARdue45()
Call OpenWkbWorkingArdue45
Call Ardue45formatting
Call CopyData
End Sub
Option Explicit
Sub OpenWkbWorkingArdue45()
Dim sPath As String
sPath = Environ("USERPROFILE") & "\Desktop\WorkingARdue45.xlsx"
Workbooks.Open Filename:=sPath
End Sub
Sub Ardue45formatting()
With Workbooks("Ardue45.xls").Worksheets(1)
Range("A2:A500").Select
Selection.ClearContents
Columns("I:I").ColumnWidth = 16.14
Columns("C:C").ColumnWidth = 12.29
Columns("C:C").ColumnWidth = 15.71
Columns("C:C").ColumnWidth = 18.29
Columns("B:B").ColumnWidth = 15.86
Columns("A:I").Select
Selection.AutoFilter
Range("D13").Select
End With
With ActiveSheet
For Each cell In .Range("A1:" & .Range("A1").End(xlDown).Address)
If .Cells(cell.Row, 7).Value > 0 Then
cell.EntireRow.Font.Bold = True
End If
Next
End With
End Sub
Sub CopyData()
Dim wbCopy As Worksheet
Dim wbDest As Worksheet
Dim lr As Long
Dim lrTarget As Long
Set wbCopy = Workbooks("Ardue45.xlsx").Worksheets(1)
Set wbDest = Workbooks("WorkingARdue45.xlsx").Worksheets(1)
wbCopy.Activate
Sheets(1).Select
lr = wbCopy.Cells.Find("*", Cells(1, 1), xlFormulas, xlPart, xlByRows, xlPrevious, False).Row
Range("A2:I" & lr).Copy
wbDest.Activate
Sheets(1).Select
lrTarget = wbDest.Cells.Find("*", Cells(1, 1), xlFormulas, xlPart, xlByRows, xlPrevious, False).Row
Cells(lrTarget + 2, 1).Select
ActiveSheet.Paste
Cells(1, 1).Select
End Sub
VBA Code:
[/CODE]
The first image below is how my data looks with the code above. The first two rows are old data and the remaining rows are the new data. The second image is how I would like it to look. Basically copying any data in columns A and E from the old data set and paste it into the new data set if there is a duplicate value in column C.