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
\$\endgroup\$
  • \$\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\$ – IvenBach Dec 20 '17 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\$ – Mast Dec 20 '17 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\$ – Leighholling Dec 20 '17 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\$ – IvenBach Dec 21 '17 at 1:02
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
\$\endgroup\$
  • \$\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\$ – Leighholling Dec 20 '17 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\$ – Leighholling Dec 20 '17 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\$ – Leighholling Dec 20 '17 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\$ – IvenBach Dec 20 '17 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\$ – Leighholling Dec 20 '17 at 21:36

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.