1
\$\begingroup\$

In this code looking at 2 worksheets that contain similar data from different systems. Column 1 contains a unique staff number so there can be a match on the person then here there is a difference in NiNo ws1.cell(,17) and ws2.cell(,24)(This criteria will change each time the full code is run, to find Date of birth for example) between the sheets then certain values for that person are copied to a 3rd sheet.

How ever there are to be 18 different worksheets all looking at different criteria, so this code will have to run 18 times and will take a while. any ideas how I can speed it up examples please.

I think the answer is to use arrays but I'm not great with arrays.

Sub NINODifferences()
 Application.ScreenUpdating = False
 Application.Calculation = xlCalculationManual
 Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet, ws4 As Worksheet
 Dim i As Long, j As Long, iCol As Long, iRow As Long, sl1 as Long, sl2 as Long
sl1 = ws1.Cells(ws1.Rows.Count, 1).End(xlUp).Row
sl2 = ws2.Cells(ws2.Rows.Count, 1).End(xlUp).Row
 Set ws1 = ActiveWorkbook.Sheets("SheetA")
 Set ws2 = ActiveWorkbook.Sheets("SheetB")
 Set ws3 = ActiveWorkbook.Sheets("NINO Differences")' this will be a different sheet as I change the criteria
 iRow = 2
 iCol = 1
 For i = 1 To sl1
 For j = 1 To sl2
 If Trim(ws1.Cells(i, 1).Value2) = Trim(ws2.Cells(j, 1).Value2) Then
 If Trim(ws1.Cells(i, 17).Value2) <> Trim(ws2.Cells(j, 24).Value2) Then 'this is the criteria so if different.
 ws3.Cells(iRow, iCol).Value2 = ws1.Cells(i, 1).Value2
 iCol = iCol + 1
 ws3.Cells(iRow, iCol).Value2 = ws1.Cells(i, 2).Value2
 iCol = iCol + 1
 ws3.Cells(iRow, iCol).Value2 = ws1.Cells(i, 3).Value2
 iCol = iCol + 1
 ws3.Cells(iRow, iCol).Value2 = ws1.Cells(i, 17).Value2
 iCol = iCol + 1
 ws3.Cells(iRow, iCol).Value2 = ws2.Cells(j, 24).Value2
 iCol = 1
 iRow = iRow + 1
 Else
 End If
 Else
 End If
 Next j
 Next i
 Set ws1 = Nothing
 Set ws2 = Nothing
 Set ws3 = Nothing
 End Sub
Mast
13.8k12 gold badges56 silver badges127 bronze badges
asked Dec 20, 2017 at 13:59
\$\endgroup\$
4
  • \$\begingroup\$ sl1 = ws1.Cells(ws1.Rows.Count, 1).End(xlUp).Row has in issue since ws1 was never set to anything, it must be set before using it. \$\endgroup\$ Commented Dec 20, 2017 at 16:52
  • \$\begingroup\$ Please do not update the code in your question to incorporate feedback from answers, doing so goes against the Question + Answer style of Code Review. This is not a forum where you should keep the most updated version in your question. Please see what you may and may not do after receiving answers . \$\endgroup\$ Commented Dec 20, 2017 at 20:36
  • \$\begingroup\$ Why so strict on rules I want help not laws this is what puts people off using these kind of forums, I apologise that said. However this code that was here is type error and is not the code i was trying to use now it reflects what i have thats working. In response to the below answer will an array appraoch be faster? Is there a way that i can change the column values from a sub so that i can simply write a new sub that will check different criteria but use the same function \$\endgroup\$ Commented Dec 20, 2017 at 20:59
  • \$\begingroup\$ Do some searches involving variant array and accessing a worksheet. CodeReview is about reviewing working code. My previous comment codereview.stackexchange.com/questions/183280/… offered that suggestion. This way you don't have any unwanted dependencies in your code. They are all injected/supplied-by-parameter allowing you to dynamically choose which columns you want. \$\endgroup\$ Commented Dec 21, 2017 at 1:02

1 Answer 1

1
\$\begingroup\$

You turn off ScreenUpdating and Calculation and never turn them back on. Make sure you do that.

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

You have your variables but the names can be improved. Variable names that describe what your code is doing will make it easier when you or whomever inherits the workbook after you has to edit it later. Declare them just before you use them, ws4 is not used anywhere and can be removed.

 Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet, ws4 As Worksheet
 Dim i As Long, j As Long, iCol As Long, iRow As Long, sl1 as Long, sl2 as Long

You're looping through rows and looking at columns using magic numbers (1, 2, 3, 17, 24) that have some meaning. I've no clue why any of them are important. Give a descriptive constant that tells you what it's there for.

Best I can discern you don't want something else done. Remove it.

If ... Then
 'SomeCode
Else
End If

Much cleaner. No "guessing" if an Else was forgotten

If ... Then
 'SomeCode
End If

You check for certain criteria before populating. Create a function for that and allow that to be your check.

If Trim(ws1.Cells(i, 1).Value2) = Trim(ws2.Cells(j, 1).Value2) Then
 If Trim(ws1.Cells(i, 17).Value2) <> Trim(ws2.Cells(j, 24).Value2) Then 'this is the criteria so if different.

Becomes. You now focus on providing what's needed for the function to return it's Boolean (True/False) instead of how it's doing it.

If IsDataValidForPopulation(primarySheet, primarySheetRow, secondarySheet, secondarySheetRow) Then

Below is the body of the function. Trim was replaced with Trim$ to avoid an implicit conversion.

Private Function IsDataValidForPopulation(ByVal primarySheet As Worksheet, ByVal primarySheetRow As Long, ByVal secondarySheet As Worksheet, secondarySheetRow As Long) As Boolean
 Const PRIMARY_SHEET_CRITERIA_COLUMN As Long = 17
 Const SECONDARY_SHEET_CRITERIA_COLUMN As Long = 24
 If Trim$(primarySheet.Cells(primarySheetRow, 1).Value2) = Trim$(secondarySheet.Cells(secondarySheetRow, 1).Value2) Then
 If Trim$(primarySheet.Cells(primarySheetRow, PRIMARY_SHEET_CRITERIA_COLUMN).Value2) <> Trim$(secondarySheet.Cells(secondarySheetRow, SECONDARY_SHEET_CRITERIA_COLUMN).Value2) Then
 IsDataValidForPopulation = True
 End If
 End If
End Function

Your population is next. The name PopulateData describes what's being done, the parameters populationSheet, populationRow, and populationColumn also self document. You were incrementing iCol several times iCol = iCol + 1 and then set it back at the end. That's been replaced and eliminates the vertical scrolling. Note: the ByRef on populationRow. This allows the incrementation done at the end to be seen by the caller and continue offsetting to the next row.

Private Sub PopulateData(ByVal primarySheet As Worksheet, ByVal primarySheetRow As Long, ByVal secondarySheet As Worksheet, ByVal secondarySheetRow As Long, ByVal populationSheet As Worksheet, ByRef populationRow As Long, ByVal populationColumn As Long)
 'Describe your magic numbers. Rename them appropriately
 Const FIRST_NUMBER As Long = 1
 Const SECOND_NUMBER As Long = 2
 Const THIRD_NUMBER As Long = 3
 Const FORTH_NUMBER As Long = 17
 Const FIFTH_NUMBER As Long = 24
 With populationSheet
 .Cells(populationRow, populationColumn).Value2 = primarySheet.Cells(primarySheetRow, FIRST_NUMBER).Value2
 .Cells(populationRow, populationColumn + 1).Value2 = primarySheet.Cells(primarySheetRow, SECOND_NUMBER).Value2
 .Cells(populationRow, populationColumn + 2).Value2 = primarySheet.Cells(primarySheetRow, THIRD_NUMBER).Value2
 .Cells(populationRow, populationColumn + 3).Value2 = primarySheet.Cells(primarySheetRow, FORTH_NUMBER).Value2
 .Cells(populationRow, populationColumn + 4).Value2 = secondarySheet.Cells(secondarySheetRow, FIFTH_NUMBER).Value2
 End With
 populationRow = populationRow + 1
End Sub

You had Set ws3 = ActiveWorkbook.Sheets("NINO Differences")' this will be a different sheet as I change the criteria which meant you'd need to change the code. Through refactoring and using the parameter populationSheet you now mandate that whoever calls this Sub needs to supply the required sheets.

Private Sub NINODifferences(ByVal primarySheet As Worksheet, ByVal secondarySheet As Worksheet, ByVal populationSheet As Worksheet)
 Application.ScreenUpdating = False
 Application.Calculation = xlCalculationManual
 Dim primarySheetLastRow As Long
 primarySheetLastRow = primarySheet.Cells(primarySheet.Rows.Count, 1).End(xlUp).Row
 Dim secondarySheetLastRow As Long
 secondarySheetLastRow = secondarySheet.Cells(secondarySheet.Rows.Count, 1).End(xlUp).Row
 Const populationColumn As Long = 1
 Dim populationRow As Long
 populationRow = 2
 Dim primarySheetRow As Long
 Dim secondarySheetRow As Long
 For primarySheetRow = 1 To primarySheetLastRow
 For secondarySheetRow = 1 To secondarySheetLastRow
 If IsDataValidForPopulation(primarySheet, primarySheetRow, secondarySheet, secondarySheetRow) Then
 PopulateData primarySheet, primarySheetRow, secondarySheet, secondarySheetRow, populationSheet, populationRow, populationColumn
 End If
 Next secondarySheetRow
 Next primarySheetRow
 Application.ScreenUpdating = True
 Application.Calculation = xlCalculationAutomatic
End Sub

You now have the option to create something like what follows to provide the sheets you need it run on. Note: I suggest renaming the Worksheets.CodeName member do be descriptive and use that in place of ActiveWorkbook.Sheets("SheetA") since you're using the name displayed on the sheet tab. If that get's changed you'll have to change your code.

Public Sub Test()
 Dim ws1 As Worksheet
 Dim ws2 As Worksheet
 Set ws1 = ActiveWorkbook.Sheets("SheetA") 'Use the Worksheet.CodeName member
 Set ws2 = ActiveWorkbook.Sheets("SheetB")
 NINODifferences ws1, ws2, ActiveWorkbook.Sheets("NINO Differences")
 NINODifferences ws1, ws2, ActiveWorkbook.Sheets("FOO Differences")
 NINODifferences ws1, ws2, ActiveWorkbook.Sheets("BAR Differences")
 NINODifferences ws1, ws2, ActiveWorkbook.Sheets("DUK Differences")
 '...
 NINODifferences ws1, ws2, ActiveWorkbook.Sheets("ZZZ Differences")
End Sub
answered Dec 20, 2017 at 18:43
\$\endgroup\$
5
  • \$\begingroup\$ I have 2 worksheets that contain similar data in different order an all in different columns except the staff number thats in col a on both sheets so what I want to do is match this number first to ensure we are looking at the same staff member on each sheet. I then want to start looking for differences in data so for example national insurance number on one sheet is stored in col 17 and col 24 on the other on the same row. \$\endgroup\$ Commented Dec 20, 2017 at 20:25
  • \$\begingroup\$ If they are different values then I want to copy the first 3 columns of the row for that staff member from sheet 1, column 17. and column 24 from sheet 2 of the row that matches the staff members staff number this will go on a separate sheet. \$\endgroup\$ Commented Dec 20, 2017 at 20:27
  • \$\begingroup\$ can't use sheet code name as this will be different every time the workbook is open as the sheets are deleted on closing and recreated on startup so in a different order but are always the same name. I have written a code that once I have all 18 reports saves them all as separate workbooks and then I don't want to save the original workbook \$\endgroup\$ Commented Dec 20, 2017 at 20:29
  • \$\begingroup\$ I understand about not being able to use CodeName. You may also be able to convert some of the columns to be parameters so those an be fed in as well. If anything wasn't clear enough let me know. Without knowing exactly all your constraints it's hard to do much more. Best of luck. \$\endgroup\$ Commented Dec 20, 2017 at 21:22
  • \$\begingroup\$ IvenBach do you have a way for me to chat direct tomorrow where i can send you sample data and i cant talk you through it \$\endgroup\$ Commented Dec 20, 2017 at 21:36

Your Answer

Draft saved
Draft discarded

Sign up or log in

Sign up using Google
Sign up using Email and Password

Post as a guest

Required, but never shown

Post as a guest

Required, but never shown

By clicking "Post Your Answer", you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.