VBA to compare worksheets; update certain columns if a match; add new row if not

R

Ruthanne

Board Regular
Joined
Mar 2, 2004
Messages
123
Thank you in advance for any help!

I would like a macro that can match column A & column B data of Worksheet(WeeklyJob) to column A & column B of Worksheet(Master) then if match is found copy column C through column F into Worksheet(Master) column C through F (and overwrite any [outdated] existing data there may be in those columns [thus updating the job's weekly charges, etc.]).
If match is not found I would like it to copy entire row from Worksheet(WeeklyJobs) into first blank row at end of Worksheet(Master) (thus giving me a new record of a new job from the weekly report).
All the columns in both worksheets are labeled the same (& row 1 is headings).

I am also open to other approaches, of course!

Thank you all for the many times this board has been of great value to me & my co-workers! I am so impressed with all the brilliant minds shining on this board!
 
Sort by date Sort by votes
I have an update, breakthrough: the following code seems working perfectly for the sample data which is comparing/matching columns A & B between 2 worksheets; sample data has 14 columns.
My problem is that I really need to compare columns D & E but and am not sure where to edit the code (my real data also has 14 columns which I would like updated in case of a Column D & E match or all 14 columns/entire row/new record added in case of no match):
Code: 
Sub newMH()
'pasted & editted from http://www.mrexcel.com/forum/showthread.php?t=99187
FinalRowSh1 = Worksheets("Master").Range("A65536").End(xlUp).Row
FinalRowSh2 = Worksheets("WeeklyJob").Range("A65536").End(xlUp).Row

For i = FinalRowSh2 To 1 Step -1
For J = FinalRowSh1 To 1 Step -1
If Worksheets("Master").Cells(J, 1) = Worksheets("WeeklyJob").Cells(i, 1) And Worksheets("Master").Cells(J, 2) = Worksheets("WeeklyJob").Cells(i, 2) Then
Worksheets("Master").Cells(J, 3) = Worksheets("WeeklyJob").Cells(i, 3)
Worksheets("Master").Cells(J, 4) = Worksheets("WeeklyJob").Cells(i, 4)
Worksheets("Master").Cells(J, 5) = Worksheets("WeeklyJob").Cells(i, 5)
Worksheets("Master").Cells(J, 6) = Worksheets("WeeklyJob").Cells(i, 6)
Worksheets("Master").Cells(J, 7) = Worksheets("WeeklyJob").Cells(i, 7)
Worksheets("Master").Cells(J, 8) = Worksheets("WeeklyJob").Cells(i, 8)
Worksheets("Master").Cells(J, 9) = Worksheets("WeeklyJob").Cells(i, 9)
Worksheets("Master").Cells(J, 10) = Worksheets("WeeklyJob").Cells(i, 10)
Worksheets("Master").Cells(J, 11) = Worksheets("WeeklyJob").Cells(i, 11)
Worksheets("Master").Cells(J, 12) = Worksheets("WeeklyJob").Cells(i, 12)
Worksheets("Master").Cells(J, 13) = Worksheets("WeeklyJob").Cells(i, 13)
Worksheets("Master").Cells(J, 14) = Worksheets("WeeklyJob").Cells(i, 14)
End If
Next J
Next i

End Sub


Sub newRecord()
Dim a, i As Long, ii As Integer, z As String
a = Sheets("WeeklyJob").Range("a1").CurrentRegion.Resize(, 14).Value
With CreateObject("Scripting.Dictionary")
    .CompareMode = vbTextCompare
    For i = 1 To UBound(a, 1)
        z = a(i, 4) & ";" & a(i, 5)
        If Not .exists(z) Then
            .Add z, Array(a(i, 1), a(i, 2), a(i, 3), a(i, 4), a(i, 5), a(i, 6), a(i, 7), a(i, 8), a(i, 9), a(i, 10), a(i, 11), a(i, 12), a(i, 13), a(i, 14))
             End If
    Next
    a = Sheets("Master").Range("a1").CurrentRegion.Resize(, 14).Value
    For i = 1 To UBound(a, 1)
        z = a(i, 1) & ";" & a(i, 2)
        If .exists(z) Then
            w = .Item(z)
            For ii = 3 To 14: a(i, ii) = w(ii - 1): Next
            .Remove z
        End If
    Next
    If .Count > 0 Then
        Sheets("Master").Range("a" & Rows.Count).End(xlUp)(2) _
        .Resize(.Count, 14).Value = Application.Transpose(Application.Transpose(.items))
    End If
End With

End Sub


Sub Multi()
     Call newMH
     Call newRecord
End Sub

I'm also not sure if the 2nd sub is intended to do what the first sub is doing. I may only need one sub but am so confused! Thanks.
 
Upvote 0

Excel Facts

How to total the visible cells?
From the first blank cell below a filtered data set, press Alt+=. Instead of SUM, you will get SUBTOTAL(9,)
I wasn't sure if the code you posted was meant to perform both operations (updating columns if match found "else" pasting new row if no match found).
The following code appears to work very good for my real data except one small problem. Code is only creating a new record if no match is found in only column D. Code is overwriting Column E of Master worksheet even if Column E does not match (I would like the code to create a new record if Column E does not match):
Code: 
Sub matchDE()
Sub update()
Dim a, i As Long, ii As Integer, z As String
a = Sheets("WeeklyJob").Range("a1").CurrentRegion.Resize(, 16).Value
With CreateObject("Scripting.Dictionary")
    .CompareMode = vbTextCompare
    For i = 1 To UBound(a, 1)
        z = a(i, 4) & ";" & a(i, 5)
        If Not .exists(z) Then
            .Add z, Array(a(i, 1), a(i, 2), a(i, 3), a(i, 4), a(i, 5), a(i, 6), a(i, 7), a(i, 8), a(i, 9), a(i, 10), a(i, 11), a(i, 12), a(i, 13), a(i, 14), a(i, 15), a(i, 16))
             End If
    Next
    a = Sheets("Master").Range("a1").CurrentRegion.Resize(, 16).Value
    For i = 1 To UBound(a, 1)
        z = a(i, 1) & ";" & a(i, 2)
        If .exists(z) Then
            w = .Item(z)
            For ii = 3 To 16: a(i, ii) = w(ii - 1): Next
            .Remove z
        End If
    Next
    If .Count > 0 Then
        Sheets("Master").Range("a" & Rows.Count).End(xlUp)(1) _
        .Resize(.Count, 16).Value = Application.Transpose(Application.Transpose(.items))
    End If
End With

End Sub

Can you please help me understand the following line of code? (I try changing the 6 & 16 to different numbers to understand but don't see any different results when executing):
Code: 
   For ii = 6 To 16: a(i, ii) = w(ii - 1): Next


I really like your code-writing! It works really fast too! I appreciate the code & all the help/training from reading other post from you and the other power programmers. Thank you very much.
 
Last edited:
Upvote 0
I'm in big trouble. I furthur tested code & it is overwriting entire rows in the Master worksheet.
I will try to clarify what I would like the code to do:
Check WeeklyJobWorksheet Column D & E; if match in MasterWorksheet then copy/paste columns A-N in same row where match is found (but do not overwrite in a non-matching row with existing data). If no match is found then copy/paste entire row at first blank row of MasterWorksheet.
Thanks in advance for any advice (please see most recent posting for current code).
 
Upvote 0
Ruthanne said:
Thank you so much for helping me Jindon.
The following is my real situation & what I would like the code to do:
Check column D & column E data of Worksheet(WeeklyJob) for a match to column D & column E of Worksheet(Master); then if match is found copy column A, B & F through P into Worksheet(Master) A, B & F through P (and overwrite any [outdated] existing data there may be in those columns [thus updating the job's weekly charges/changes, etc.]).
If match is not found I would like it to copy entire row from Worksheet(WeeklyJobs) into first blank row at end of Worksheet(Master) (thus giving me a new record of a new job from the weekly report).
All the columns in both worksheets are labeled the same (& row 1 is headings).

Many thanks again & kind regards!
Ruth
Click to expand...
try
Code: 
Sub test()
Dim a, i As Long, ii As Integer, z As String
Dim n As Long, AB(), F_P(), x As Long, e
a = Sheet("WeeklyJob").Range("a1").CurrentRegion.Resize(,16).Value
ReDim AB(1 To UBound(a,1), 1 To 2)
ReDim F_P(1 To UBound(a,1), 1 To 11)
With CreateObject("Scripting.Dictionary")
    .CompareMode = vbTextCompare
    For i = 1 To UBound(a,1)
        z = a(i,4) & ";" & a(i,5)
        If Not .exists(z) Then
            n = n + 1
            For ii = 1 To 13 
                If ii < 3 Then
                    AB(n,ii) = a(i,ii)
                Else
                    F_P(n, ii - 2) = a(i, ii + 3)
                End If
            .add z, n
        End If
    Next
    a = Sheets("Master").Range("a1").CurrentRegion.Resize(,16).Value
    For i = 1 To UBound(a,1)
        z = a(i,4) & ";" & a(i,5)
        If .exists(z) Then
            x = .item(z)
            For ii = 1 To 13
                If ii < 3 Then
                    a(i,ii) = AB(x, ii)
                Else
                    a(i, ii + 3) = F_P(x, ii - 2)
                End If
            Next
            .remove z
        End If
    Next
    Sheets("Master").Range("a1").CurrentRegion.Resize(,16).Value = a
    If .count > 0 Then
        ReDim a(1 To .Count, 1 To 16) : n = 0
        For Each e In .keys
            x = .item(e) : n = n + 1
            For ii = 1 To 13
                If ii < 3 Then
                    a(n, ii) = AB(x,ii)
                Else
                    a(n, ii + 3) = F_P(x, ii - 2)
                End If
            Next
        Next
        Sheets("Master").Range("a" & Rows.Count).End(xlUp)(2) _
        .Resize(n, 16).Value = a
    End If
End With
End Sub
 
Upvote 0
Thanks so much for the code & the help.
I am getting an error message that the "FOR" variable is already used (regarding the 2nd occurence of the line:
Code: 
"For i = 1 To UBound(a, 1)"

However I did not get this error message with the previous code posted & it appears to have the same variable used twice. I wonder why.
I should mention that I deleted the 2nd occurence of "end if" since there was an error message that said "end if without block if".

Thanks!
 
Last edited:
Upvote 0
I am trying to fix the bugs. Compiler has given me several error messages:
Block if without end if.
End if withouth block if.
End With without With.
"FOR" variable is already used (for i as Long)
...so I am trying to figure out where the edits are needed but have not been successful...yet!
Thank you.
Sincerely,
Ruth
 
Last edited:
Upvote 0
Missed "Next"
Rich (BB code): 
Sub test()
Dim a, i As Long, ii As Integer, z As String
Dim n As Long, AB(), F_P(), x As Long, e
a = Sheet("WeeklyJob").Range("a1").CurrentRegion.Resize(,16).Value
ReDim AB(1 To UBound(a,1), 1 To 2)
ReDim F_P(1 To UBound(a,1), 1 To 11)
With CreateObject("Scripting.Dictionary")
    .CompareMode = vbTextCompare
    For i = 1 To UBound(a,1)
        z = a(i,4) & ";" & a(i,5)
        If Not .exists(z) Then
            n = n + 1
            For ii = 1 To 13 
                If ii < 3 Then
                    AB(n,ii) = a(i,ii)
                Else
                    F_P(n, ii - 2) = a(i, ii + 3)
                End If
            Next
            .add z, n
        End If
    Next
    a = Sheets("Master").Range("a1").CurrentRegion.Resize(,16).Value
    For i = 1 To UBound(a,1)
        z = a(i,4) & ";" & a(i,5)
        If .exists(z) Then
            x = .item(z)
            For ii = 1 To 13
                If ii < 3 Then
                    a(i,ii) = AB(x, ii)
                Else
                    a(i, ii + 3) = F_P(x, ii - 2)
                End If
            Next
            .remove z
        End If
    Next
    Sheets("Master").Range("a1").CurrentRegion.Resize(,16).Value = a
    If .count > 0 Then
        ReDim a(1 To .Count, 1 To 16) : n = 0
        For Each e In .keys
            x = .item(e) : n = n + 1
            For ii = 1 To 13
                If ii < 3 Then
                    a(n, ii) = AB(x,ii)
                Else
                    a(n, ii + 3) = F_P(x, ii - 2)
                End If
            Next
        Next
        Sheets("Master").Range("a" & Rows.Count).End(xlUp)(2) _
        .Resize(n, 16).Value = a
    End If
End With
End Sub
 
Upvote 0
Thank you so much Jindon. This code is working very well. There is one problem though. When the code finds no matching record in WorksheetMaster it is copying "blank cells" into column D & E from WSWeeklyJob to WSMaster. Then when I run macro again it continues to copy "blank cells" over existing data in Col D&E of WS Master.
I am trying very hard to change the code!

p.s. I will be on vacation camping for one week...no power & no computers! So I will say a heartfelt thanks to you now! Kampai to the master!
 
Upvote 0
Can anyone help me edit the above vba to highlight the cells that are different in the second sheet and put what is not in the second file in a separte sheet?
 
Upvote 0
Can anyone help me edit the above vba to highlight the cells that are different in the second sheet and put what is not in the second file in a separte sheet?
<!-- / message -->
 
Upvote 0
You must log in or register to reply here.

Similar threads

M
  • Solved
Copy and paste multiple matching rows to a new sheet
Replies
6
Views
74
Multim
M
W
  • Solved
Moving/transferring data between tables with matching column names, not by column order - vba
Replies
5
Views
237
Alex Blakenburg
A
D
  • Question
Auto-Update Problem
Replies
0
Views
262
Diulama1023
D
A
  • Question
Dynamically add new rows via VBA when using IFERROR TEXTJOIN and FILTER formulas from Table?
Replies
0
Views
82
AlfredDB
A
I
  • Question
Copy worksheet but the new worksheet to omit some items
2
Replies
11
Views
438
ipbr21054
I

Forum statistics

Threads
1,215,059
Messages
6,122,918
Members
449,094
Latest member
teemeren

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top