Macro

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
 

Excel Facts

Best way to learn Power Query?
Read M is for (Data) Monkey book by Ken Puls and Miguel Escobar. It is the complete guide to Power Query.
Hi Apple08,

no action being taken for the check if the cells are equal to "PVC-S" as the code directly continues with an ElseIf.

HTH,
Holger
 
Upvote 0
Thanks, I update the macro as below, is that correct please:

VBA Code:
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

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).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

Next ZZ

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
 
Upvote 0
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
 
Upvote 0
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
Thanks very much Hoilger, the macro runs more than 30 minutes, therefore I have to stop it running. I wonder is there anyway to speed it up? Many thanks.
 
Upvote 0
Thanks very much Hoilger, the macro runs more than 30 minutes, therefore I have to stop it running. I wonder is there anyway to speed it up? Many thanks.
See if the following helps at all. Place this at the beginning of your code:
VBA Code:
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
and then place this at the end of your code:
VBA Code:
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
Sometimes, suspending all calculations and screen updates while the code is running helps speed things up.
 
Upvote 0
Thanks, unfortunately the macros still take a long time to run, I wonder if I simplify the code as below does it help? I think the code below doesn't work for the time being, please could you help to update the code.

VBA Code:
Sub C2_Reconcile2020()

Dim ws1 As Worksheet, ws As Worksheet, lastrow As Long, LRow As Long, i As Long, r As Long, 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 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
 
Upvote 0
Hi,​
yes this kind of code can last a while when looping cell by cell instead of using the faster Excel basics often without needing any loop !​
If at least you post an attachment with a complete crystal clear explanation of your need it should be easier for any helper to find out a faster way …​
 
Upvote 0
Can you explain, in plain English, exactly what it is that your code is supposed to do?
I do not see an explanation anywhere, nor do I see any examples of what the data looks like.
 
Upvote 0
I have two spreadsheets: SUP Tracker and Change Log. I need to reconcile Change Log against SUP Tracker, if the item in column A = PVC-S, and the cells A,B,C,E,F are matched in both spreadsheets, then find out the variance in highlighted cell D, and G to K in Change Log and update the cell values in SUP Tracker. Other than PVC-S. if the cells are matched in cell A,B,E,F, then highlight the cells in variance in Change Log and update the the cell values in SUP Tracker.

The latest code I provided I just ignore PVC-S as I think it may cause much time to run the code. Many thanks.
 
Upvote 0

Forum statistics

Threads
1,214,413
Messages
6,119,372
Members
448,888
Latest member
Arle8907

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