Macro

A

Apple08

Active Member
Joined
Nov 1, 2014
Messages
450
Hi All

I have a macro below, however it doesn't pick up any changes for PVC-S but it works for the rest. Please could anyone help to point out the mistake?

VBA Code: 
Private Sub C2_Reconcile2020()

Dim ws1 As Worksheet, ws As Worksheet, lastrow As Long, LRow As Long, i As Long, r As Long

Set ws = Worksheets("SUP Tracker")
Set ws1 = Worksheets("Change Log")

lastrow = ws.Cells(Rows.Count, "A").End(xlUp).Row
LRow = ws1.Cells(Rows.Count, "A").End(xlUp).Row

For i = LRow To 2 Step -1
For r = lastrow To 2 Step -1
 'Y modules may have same item used for multiple presentations
If ws.Cells(r, "A").Value = "PVC-S" _
And ws1.Cells(i, "A").Value = ws.Cells(r, "A").Value _
And ws1.Cells(i, "B").Value = ws.Cells(r, "B").Value _
And ws1.Cells(i, "C").Value = ws.Cells(r, "C").Value _
And ws1.Cells(i, "E").Value = ws.Cells(r, "E").Value _
And ws1.Cells(i, "F").Value = ws.Cells(r, "F").Value Then

ElseIf ws.Cells(r, "A").Value <> "PVC-S" _
And ws1.Cells(i, "A").Value = ws.Cells(r, "A").Value _
And ws1.Cells(i, "B").Value = ws.Cells(r, "B").Value _
And ws1.Cells(i, "E").Value = ws.Cells(r, "E").Value _
And ws1.Cells(i, "F").Value = ws.Cells(r, "F").Value Then

For Each Z In Array("C", "D", "G", "H", "I", "J", "K")

If ws1.Cells(i, Z).Value <> ws.Cells(r, Z).Value Then
ws1.Cells(i, Z).Interior.ColorIndex = 6
ws.Cells(r, Z).Value = ws1.Cells(i, Z).Value

End If

Next Z

End If

Next r
Next i


End Sub
 
Sort by date Sort by votes
​
So to make your procedure running faster just compare the cells with their concatenations rather than cell by cell …​
 
Upvote 0

Excel Facts

Links? Where??
If Excel says you have links but you can't find them, go to Formulas, Name Manager. Look for old links to dead workbooks & delete.
​
No chance to waste any time without the necessary as explicitly mentionned in posts #8 & 9 …​
 
Upvote 0
HaHoBe said:
Hi Apple08,

you should take care to have the elements in the code closed at proper places.

Code: 
ElseIf ws.Cells(r, "A").Value <> "PVC-S" _
must end before you put
Code: 
Next ZZ

Code may look like this (although I´m not sure it´s what you are after):
Code: 
Private Sub C2_Reconcile2020()
Dim ws1 As Worksheet, ws As Worksheet, lastrow As Long, LRow As Long, i As Long, r As Long

Dim ZZ As Variant, Z As Variant


Set ws = Worksheets("SUP Tracker")
Set ws1 = Worksheets("Change Log")

lastrow = ws.Cells(Rows.Count, "A").End(xlUp).Row
LRow = ws1.Cells(Rows.Count, "A").End(xlUp).Row

For i = LRow To 2 Step -1
  For r = lastrow To 2 Step -1
   'Y modules may have same item used for multiple presentations
    If ws.Cells(r, "A").Value = "PVC-S" _
          And ws1.Cells(i, "A").Value = ws.Cells(r, "A").Value _
          And ws1.Cells(i, "B").Value = ws.Cells(r, "B").Value _
          And ws1.Cells(i, "C").Value = ws.Cells(r, "C").Value _
          And ws1.Cells(i, "E").Value = ws.Cells(r, "E").Value _
          And ws1.Cells(i, "F").Value = ws.Cells(r, "F").Value Then
      For Each ZZ In Array("D", "G", "H", "I", "J", "K")
        If ws1.Cells(i, ZZ).Value <> ws.Cells(r, ZZ).Value Then
          ws1.Cells(i, ZZ).Interior.ColorIndex = 6
          ws.Cells(r, ZZ).Value = ws1.Cells(i, Z).V
        ElseIf ws.Cells(r, "A").Value <> "PVC-S" _
              And ws1.Cells(i, "A").Value = ws.Cells(r, "A").Value _
              And ws1.Cells(i, "B").Value = ws.Cells(r, "B").Value _
              And ws1.Cells(i, "E").Value = ws.Cells(r, "E").Value _
              And ws1.Cells(i, "F").Value = ws.Cells(r, "F").Value Then
          For Each Z In Array("C", "D", "G", "H", "I", "J", "K")
            If ws1.Cells(i, Z).Value <> ws.Cells(r, Z).Value Then
              ws1.Cells(i, Z).Interior.ColorIndex = 6
              ws.Cells(r, Z).Value = ws1.Cells(i, Z).Value
            End If
          Next Z
        End If
      Next ZZ
    End If
  Next r
Next i

End Sub
Ciao,
Hoilger
Click to expand...
Sorry guys, I have my colleague to try the above macro and he told me it only took him 5 minutes to run with the Application procedures....I think my laptop may have bugs after so many macros trying. However only the PVC-S variants have been picked and highlighted but not the rest, I wonder is it something missing in the code?
 
Upvote 0
This is the code my colleague has tried, it only took him 5 mins but it can only pick up the changes for PVC-S but not others:

VBA Code: 
Private Sub C2_Reconcile2020()

 Application.ScreenUpdating = False
 Application.Calculation = xlCalculationManual

Dim ws1 As Worksheet, ws As Worksheet, lastrow As Long, LRow As Long, i As Long, r As Long

Dim ZZ As Variant, Z As Variant


Set ws = Worksheets("SUP Tracker")
Set ws1 = Worksheets("Change Log")

lastrow = ws.Cells(Rows.Count, "A").End(xlUp).Row
LRow = ws1.Cells(Rows.Count, "A").End(xlUp).Row

For i = LRow To 2 Step -1
  For r = lastrow To 2 Step -1
   'Y modules may have same item used for multiple presentations
    If ws.Cells(r, "A").Value = "PVC-S" _
          And ws1.Cells(i, "A").Value = ws.Cells(r, "A").Value _
          And ws1.Cells(i, "B").Value = ws.Cells(r, "B").Value _
          And ws1.Cells(i, "C").Value = ws.Cells(r, "C").Value _
          And ws1.Cells(i, "E").Value = ws.Cells(r, "E").Value _
          And ws1.Cells(i, "F").Value = ws.Cells(r, "F").Value Then
      
      For Each ZZ In Array("D", "G", "H", "I", "J", "K")
        If ws1.Cells(i, ZZ).Value <> ws.Cells(r, ZZ).Value Then
          ws1.Cells(i, ZZ).Interior.ColorIndex = 6
          ws.Cells(r, ZZ).Value = ws1.Cells(i, ZZ).Value
          
        ElseIf ws.Cells(r, "A").Value <> "PVC-S" _
              And ws1.Cells(i, "A").Value = ws.Cells(r, "A").Value _
              And ws1.Cells(i, "B").Value = ws.Cells(r, "B").Value _
              And ws1.Cells(i, "E").Value = ws.Cells(r, "E").Value _
              And ws1.Cells(i, "F").Value = ws.Cells(r, "F").Value Then
          
          For Each Z In Array("C", "D", "G", "H", "I", "J", "K")
          
            If ws1.Cells(i, Z).Value <> ws.Cells(r, Z).Value Then
              ws1.Cells(i, Z).Interior.ColorIndex = 6
              ws.Cells(r, Z).Value = ws1.Cells(i, Z).Value
            End If
          Next Z
        End If
      Next ZZ
    End If
  Next r
Next i

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub
 
Upvote 0
Hi Apple08,

my bad there were problems putting the End If and Nexr to the proper places..

Code: 
Private Sub C2_Reconcile2020_3()
Dim ws1 As Worksheet, ws As Worksheet, lastrow As Long, LRow As Long, i As Long, r As Long

Dim ZZ As Variant, Z As Variant

With Application
  .ScreenUpdating = False
  .Calculation = xlCalculationManual
End With

Set ws = Worksheets("SUP Tracker")
Set ws1 = Worksheets("Change Log")

lastrow = ws.Cells(Rows.Count, "A").End(xlUp).Row
LRow = ws1.Cells(Rows.Count, "A").End(xlUp).Row

For i = LRow To 2 Step -1
  For r = lastrow To 2 Step -1
   
   'Y modules may have same item used for multiple presentations
    If ws.Cells(r, "A").Value = "PVC-S" _
          And ws1.Cells(i, "A").Value = ws.Cells(r, "A").Value _
          And ws1.Cells(i, "B").Value = ws.Cells(r, "B").Value _
          And ws1.Cells(i, "C").Value = ws.Cells(r, "C").Value _
          And ws1.Cells(i, "E").Value = ws.Cells(r, "E").Value _
          And ws1.Cells(i, "F").Value = ws.Cells(r, "F").Value Then
      For Each ZZ In Array("D", "G", "H", "I", "J", "K")
        If ws1.Cells(i, ZZ).Value <> ws.Cells(r, ZZ).Value Then
          ws1.Cells(i, ZZ).Interior.ColorIndex = 6
          ws.Cells(r, ZZ).Value = ws1.Cells(i, Z).V
        End If
      Next ZZ
    
    ElseIf ws.Cells(r, "A").Value <> "PVC-S" _
          And ws1.Cells(i, "A").Value = ws.Cells(r, "A").Value _
          And ws1.Cells(i, "B").Value = ws.Cells(r, "B").Value _
          And ws1.Cells(i, "E").Value = ws.Cells(r, "E").Value _
          And ws1.Cells(i, "F").Value = ws.Cells(r, "F").Value Then
      For Each Z In Array("C", "D", "G", "H", "I", "J", "K")
        If ws1.Cells(i, Z).Value <> ws.Cells(r, Z).Value Then
          ws1.Cells(i, Z).Interior.ColorIndex = 6
          ws.Cells(r, Z).Value = ws1.Cells(i, Z).Value
        End If
      Next Z
    End If
  
  Next r
Next i

With Application
  .ScreenUpdating = True
  .Calculation = xlAutomatic
End With

End Sub
I hope to have fixed the error.

Holger
 
Upvote 0
Solution
Hi Aple08,

have you thought about using Autofilter on both sheets and only looping throught the visible cells to do the comparision of cells? That should cut down the execution time of the macro as you would only have to deal with a limited number of rows to run through.

If there is only one match on the data of each sheet another ides would be to use an extra column next to the data on sheet2 to decide whether the set has to be checked. If a match is found either an x or a date-time-stamp yould be placed in that column. As I do not know your data this may help with the number of checks to be made for each loop. This extra column would be deleted by the end of the makro.

Ciao,
Jolger
 
Upvote 0
It works perfectly now and the running time only takes 5 to 6 minutes! It's my my mistake I have used a wrong Change Log to test the macro therefore it took so long. I really appreciated all of your help from everyone who have spent time and effort in helping me especially to Jolger (or Holger?). You all have made my life much more easier, many many thanks! :)
 
Upvote 0
You must log in or register to reply here.

Similar threads

G
  • Question
Stop excel macro from running if there is a blank cell in a column
Replies
4
Views
126
RobP
R
T
  • Solved
List values in an array?
Replies
4
Views
147
RoryA
RoryA
B
  • Question
Matching Multiple Header Row Cell Values - Copy the data below to next available row.
Replies
1
Views
177
bobaol
B
T
  • Question
Amend values populating an array?
Replies
2
Views
147
TheWennerWoman
T
P
  • Question
Code used for comparison between 2 list.
Replies
3
Views
291
Tupe77
T

Forum statistics

Threads
1,214,379
Messages
6,119,190
Members
448,874
Latest member
Lancelots

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