View Full Version : Solved: Comparing Between 2 Workbooks and Inserting Missing Data
steelstorm
05-07-2012, 11:08 AM
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
05-08-2012, 06:13 AM
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
05-08-2012, 06:51 AM
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
05-08-2012, 06:57 AM
you're wellcome.
if not solved, post the entirety of the code so that we can try together...
steelstorm
05-08-2012, 07:21 AM
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
05-08-2012, 07:43 AM
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
05-08-2012, 08:39 AM
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
05-08-2012, 02:05 PM
you are wellcome.
i called this procedure from another sub and it worked for me.
steelstorm
05-09-2012, 05:01 AM
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
05-09-2012, 07:07 AM
:)
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.