Solved: Comparing Between 2 Workbooks and Inserting Missing Data

[steelstorm]

I am comparing data that is in Workbook2 to Workbook1. On Workbook2, sheet1 there is a column named Order ID (column A) What I am trying to do is compare every Order ID to that same exact column Order ID (column A) on Workbook2, sheet 1. And if a matching Order ID is found copy the data from Workbook2, Column F in that corresponding row to Workbook1sheet1 in Column H to the corresponding Order ID.
Ex:
Workbook2,Sheet1:
Column A: _ Column F:
Order ID _ Status Update
1530423947 _ Being sent today
1530425710 _ Being sent today
1530427861 _ working to get revised report in ASAP
1530429263 _ Being sent today
1530429147 _ Report due 4/20
1530429145 _ Being sent today
1530429643 _ Report due 4/20

Workbook1,Sheet1:
Column A: _ Column H:
Order ID _ Status Update
1530429643
1530429145
1530429147

End Result on Workbook1,Sheet1:
Order ID _ Status Update
1530429643 _ Report due 4/20
1530429145 _ Being sent today
1530429147 _ Report due 4/20

I’m still pretty new to all this and I’ve just been having issues lately wrapping my head around some of the newer concepts I need to implement. Thanks is advance for any help or advice.

[mancubus]

hi and wellcome to the forum.

copy the code below to Workbook1's code module


Sub FindNCopy()

Dim wb1 As Workbook, wb2 As Workbook
Dim rng As Range, cll As Range
Dim LR As Long, fRow As Long

Set wb1 = ThisWorkbook
Set wb2 = Workbooks("Book2.xlsx") 'change Book2.xlsx to actual Workbook2's name

With wb1.Worksheets("Sheet1")
LR = .Cells(.Rows.Count, "A").End(xlUp).Row
Set rng = .Range("A2:A" & LR)
For Each cll In rng
On Error Resume Next
fRow = Application.Match(cll.Value, wb2.Worksheets("Sheet1").Columns("A"), 0)
If fRow > 0 Then
.Cells(cll.Row, "H").Value = wb2.Worksheets("Sheet1").Cells(fRow, "F").Value
End If
On Error GoTo 0
Next
End With

End Sub

[steelstorm]

It works perfectly. For some reason I am having issues calling it in an existing module I have but I will be able to figure it out as soon as I down some more coffee.

Stand alone it works for exactly what I need. Thank you for the help and the learning experience.

[mancubus]

you're wellcome.

if not solved, post the entirety of the code so that we can try together...

[steelstorm]

It runs perfect until this line of code I added to your macro, It does add this header but then seems to stop and does not do the comparing part.

Range("h1").Value = "Previous Days Update"
Range("h1").Font.Bold = True

Below is the code, please do not laugh too much I'm still learning:)

Sub phil()

'
' Macro1 Macro
'
Rows("1:9").Delete
Columns("A:E").Delete
Columns("B:B").Delete
Columns("C:C").Delete
Columns("E:E").Delete
Columns("F:G").Delete
Columns("I:K").Delete

Range("A1").Select

Call DeleteRows384

Range("i1").Value = "Status Update"
Range("i1").Font.Bold = True
Columns("C:D").Delete


Call DateSort
Call FindNCopy


End Sub
Sub DeleteRows384()
Dim c As Range
Dim SrchRng

Set SrchRng = ActiveSheet.Range("C1", ActiveSheet.Range("C65536").End(xlUp))
Do
Set c = SrchRng.Find("384", LookIn:=xlValues)
If Not c Is Nothing Then c.EntireRow.Delete
Loop While Not c Is Nothing

End Sub
Sub DateSort()
Application.ScreenUpdating = False
Range("B2").CurrentRegion.Sort Key1:=Range("B2"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Application.ScreenUpdating = True
End Sub
Sub FindNCopy()

Dim wb1 As Workbook, wb2 As Workbook
Dim rng As Range, cll As Range
Dim LR As Long, fRow As Long

Set wb1 = ThisWorkbook
Set wb2 = Workbooks("Digital - 5.4") 'change Book2.xlsx to actual Workbook2's name
Range("h1").Value = "Previous Days Update"
Range("h1").Font.Bold = True


With wb1.Worksheets("Sheet1")
LR = .Cells(Rows.Count, "A").End(xlUp).Row
Set rng = .Range("$A$2:$A$" & LR)
For Each cll In rng
On Error Resume Next
fRow = Application.Match(cll.Value, wb2.Worksheets("Sheet1").Columns("A"), 0)
If fRow > 0 Then
.Cells(cll.Row, "H") = wb2.Worksheets("Sheet1").Cells(fRow, "F").Value
End If
On Error GoTo 0
Next
End With

Cells.EntireColumn.AutoFit
Cells.EntireColumn.HorizontalAlignment = xlHAlignCenter
Columns("C:F").EntireColumn.Hidden = True


End Sub




Also, is there a way when naming Workbook two to have it use anything that is open with a like name? My workbook for this one for example was Digital - 5.4, the 5.4 was the date so this will obviously change alot. I was curious if their is some kind of syntax that will just compare with any open workbook that is opened and named Digital.

Thanks in advance for any advice.

[mancubus]

how about this?

With wb1.Worksheets("Sheet1")
.Range("H1").Value = "Previous Days Update"
.Range("H1").Font.Bold = True
LR = .Cells(Rows.Count, "A").End(xlUp).Row
...
...
...
...
End With

[steelstorm]

I still could not get it to work for some reason........but after talking to my buddy I am making this for he actually said he would like to be able to run them both seperately......which totally solves the problem:)

Thanks again for all your help!

[mancubus]

you are wellcome.

i called this procedure from another sub and it worked for me.

[steelstorm]

I'm not sure what happened myself. The first few times I ran it I did not get an error it would just seem to stop at the part inserting the information from another sheet.

After wracking my head for a bit I tried it again because I just could not understand why it would not work......and it seemed to work flawless after that so it's all good now:)

Thanks again for all the help.

[mancubus]

:)