Macro

Apple08

Active Member
Joined
Nov 1, 2014
Messages
404
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
 

Marc L

Well-known Member
Joined
Apr 5, 2021
Messages
1,263
Office Version
  1. 2010
Platform
  1. Windows
So to make your procedure running faster just compare the cells with their concatenations rather than cell by cell …​
 

Excel Facts

Formula for Yesterday
Name Manager, New Name. Yesterday =TODAY()-1. OK. Then, use =YESTERDAY in any cell. Tomorrow could be =TODAY()+1.

Marc L

Well-known Member
Joined
Apr 5, 2021
Messages
1,263
Office Version
  1. 2010
Platform
  1. Windows
No chance to waste any time without the necessary as explicitly mentionned in posts #8 & 9 …​
 

Apple08

Active Member
Joined
Nov 1, 2014
Messages
404
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
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?
 

Apple08

Active Member
Joined
Nov 1, 2014
Messages
404

ADVERTISEMENT

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
 

HaHoBe

Active Member
Joined
Jan 24, 2003
Messages
490
Office Version
  1. 2013
Platform
  1. Windows
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
 
Solution

HaHoBe

Active Member
Joined
Jan 24, 2003
Messages
490
Office Version
  1. 2013
Platform
  1. Windows
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
 

Apple08

Active Member
Joined
Nov 1, 2014
Messages
404
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! :)
 

Forum statistics

Threads
1,141,705
Messages
5,707,976
Members
421,539
Latest member
zuniBM

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
Top