barskyn
barskyn

Reputation: 383

VBA-Iterating through worksheets and finding occurrences of values, make it more efficient

I am iterating through a workbook and searching how many times are person1 and val1 in the same row and then adding 1 to a specified cell for each time this happens. The only way I could make this work was by copying and pasting the following code for each individual person. This becomes too inefficient for many people and excel will not run it, any recommendations as how I can avoid mass copying and pasting?

Sub Main()

    Dim ws As Worksheets 'remember which worksheet is active in the beginning
    Dim starting_ws As Worksheet
    Set starting_ws = ActiveSheet 'remember which worksheet is active in the beginning
    'Set MyRng =
    ws_num = ThisWorkbook.Worksheets.Count - 4

    For I = 1 To ws_num
        ind = 9
        ThisWorkbook.Worksheets(I).Activate
        Do While ind <= 39


            If Worksheets(I).Range("A" & ind).Value = "person1" And Worksheets(I).Range("G" & ind).Value = "val1" Then
                Worksheets("scrap").Range("C7").Value = Worksheets("scrap").Range("C7").Value + 1
            ElseIf Worksheets(I).Range("A" & ind).Value = "person1" And Worksheets(I).Range("G" & ind).Value = "val2" Then
                Worksheets("scrap").Range("B7").Value = Worksheets("scrap").Range("B7").Value + 1
            ElseIf Worksheets(I).Range("A" & ind).Value = "person1" And Worksheets(I).Range("G" & ind).Value = "val3" Then
                Worksheets("scrap").Range("D7").Value = Worksheets("scrap").Range("D7").Value + 1
            ElseIf Worksheets(I).Range("A" & ind).Value = "person1" And Worksheets(I).Range("G" & ind).Value = "val4" Then
                Worksheets("scrap").Range("E7").Value = Worksheets("scrap").Range("E7").Value + 1
            ElseIf Worksheets(I).Range("A" & ind).Value = "person1" And Worksheets(I).Range("G" & ind).Value = "val5" Then
                Worksheets("scrap").Range("F7").Value = Worksheets("scrap").Range("F7").Value + 1
            ElseIf Worksheets(I).Range("A" & ind).Value = "person1" And Worksheets(I).Range("G" & ind).Value = "val6" Then
                Worksheets("scrap").Range("G7").Value = Worksheets("scrap").Range("G7").Value + 1
            ElseIf Worksheets(I).Range("A" & ind).Value = "person1" And Worksheets(I).Range("G" & ind).Value = "val7" Then
                Worksheets("scrap").Range("H7").Value = Worksheets("scrap").Range("H7").Value + 1
            ElseIf Worksheets(I).Range("A" & ind).Value = "person1" And Worksheets(I).Range("G" & ind).Value = "val8" Then
                Worksheets("scrap").Range("I7").Value = Worksheets("scrap").Range("I7").Value + 1
            ElseIf Worksheets(I).Range("A" & ind).Value = "person1" And Worksheets(I).Range("G" & ind).Value = "val9" Then
                Worksheets("scrap").Range("J7").Value = Worksheets("scrap").Range("J7").Value + 1
            ElseIf Worksheets(I).Range("A" & ind).Value = "person1" And Worksheets(I).Range("G" & ind).Value = "val10" Then
                Worksheets("scrap").Range("K7").Value = Worksheets("scrap").Range("K7").Value + 1
            ElseIf Worksheets(I).Range("A" & ind).Value = "person1" And Worksheets(I).Range("G" & ind).Value = "val11" Then
                Worksheets("scrap").Range("L7").Value = Worksheets("scrap").Range("L7").Value + 1



            End If
            ind = ind + 1
        Loop


    Next

Upvotes: 0

Views: 39

Answers (2)

urdearboy
urdearboy

Reputation: 14590

Building on cybernetic.nomads solution, you can house your Case inside a loop of your array Persons. You will need to update this array with all values you want to loop through of course.

Dimmed your "Scrap" worksheet for aesthetic reasons.
Removed .Value where possible.
Turn off ScreenUpdating for good measure to spare memory.

Sub Main()

Dim ws As Worksheets 'remember which worksheet is active in the beginning
Dim starting_ws As Worksheet
Set starting_ws = ActiveSheet 'remember which worksheet is active in the beginning
ws_num = ThisWorkbook.Worksheets.Count - 4

Dim Scrap As Worksheet
Set Scrap = ThisWorkbook.Sheets("Scrap")

Dim P As Integer
Dim Persons As Variant
Persons = Array("person1", "person2", "person3", "personN")        

Application.ScreenUpdating = False

For P = LBound(Persons) To UBound(perons)
    For I = 1 To ws_num
    ind = 9
        Do While ind <= 39
            If Worksheets(I).Range("G" & ind).Value = Persons(P) Then
                Select Case Worksheets(I).Range("G" & ind.Value)
                    Case "val1"
                        Scrap.Range("C7") = Scrap.Range("C7").Value + 1
                    Case "val2"
                        Scrap.Range("B7") = Scrap.Range("B7").Value + 1
                    Case "val3"
                         Scrap.Range("D7") = Scrap.Range("D7").Value + 1
                    Case "val4"
                         Scrap.Range("E7") = Scrap.Range("E7").Value + 1
                    Case "val5"
                         Scrap.Range("F7") = Scrap.Range("F7").Value + 1
                    Case "val6"
                         Scrap.Range("G7") = Scrap.Range("G7").Value + 1
                    Case "val7"
                         Scrap.Range("H7") = Scrap.Range("H7").Value + 1
                    Case "val8"
                         Scrap.Range("I7") = Scrap.Range("I7").Value + 1
                    Case "val9"
                         Scrap.Range("J7") = Scrap.Range("J7").Value + 1
                    Case "val0"
                         Scrap.Range("J7") = Scrap.Range("K7").Value + 1
                    Case "val11"
                         Scrap.Range("L7") = Scrap.Range("L7").Value + 1
                End Select
            End If
        ind = ind + 1
        Loop
    Next I
Next P

Application.ScreenUpdating = True


End Sub

Upvotes: 1

cybernetic.nomad
cybernetic.nomad

Reputation: 6418

To begin with you could use:

If Worksheets(I).Range("A" & ind).Value = "person1" Then

To only evaluate that once. then use

Select Case Worksheets(I).Range("G" & ind).Value
    Case "val1" 
        Worksheets("scrap").Range("C7").Value = Worksheets("scrap").Range("C7").Value + 1
    Case "val2"
        Worksheets("scrap").Range("B7").Value = Worksheets("scrap").Range("B7").Value + 1

And so on

As clarified by urdearboy, the above should be in the loop, replacing all those If...Elseifs

Upvotes: 1

Related Questions