loop thru series of rows and insert data

breilly00

Board Regular
Joined
Sep 15, 2008
Messages
53
Office Version
  1. 365
Platform
  1. Windows
I am trying to figure out how to find a missing number in a range of rows. I can get the following to work by hard coding the statements to look at the first range of cells. LowerVal & UpperVal calculated previously (pseudo code below)

Dim InputRange As Range
Dim ValueFound As Range
Dim LowerVal As Integer
Dim UpperVal As Integer
Dim S1 As Integer

'Set search range
Set InputRange = Range("c2:d6")

'Search for team that has a bye
For S1 = LowerVal To UpperVal
Set ValueFound = InputRange.Find(S1)
If ValueFound Is Nothing Then
Sheets("rawdata").Range("C7") = S1, Sheets(“rawdata”).range(“D7”) = “bye”
End If
Next S1

I am trying to figure out a way to loop thru a series of rows. (The rows are in a format like below). The objective is to identify what team has a bye (their team number is missing) by searching the home & away columns for the team numbers, find the missing team number and then write that number (and the word ‘bye’ to a blank row under the searched range. Note: a separate macro has been used to insert a blank row after each date. If it is easier to insert the blank row as part of this query, then the “blank row insert’ query can be tossed out.

Each season the number of teams, location and the dates will change which will change the amount of data- but not the format. Can I get some help on how to loop thru the raw data, find the missing team for each scheduled date of play and insert their team number in the blank row indicating that they have a bye week?

A sample of the rawdata worksheet is below

ColA ColB ColC ColD ColE
Date Time Home Away Location
5/7/2019 10:00 AM 8 10 4
5/7/2019 10:00 AM 1 9 1
5/7/2019 10:00 AM 7 6 5
5/7/2019 10:00 AM 3 5 2
5/7/2019 10:00 AM 11 4 6

5/14/2019 10:00 AM 2 9 3
5/14/2019 10:00 AM 6 10 2
5/14/2019 10:00 AM 7 5 1
5/14/2019 10:00 AM 1 11 5
5/14/2019 10:00 AM 8 4 4

5/21/2019 10:00 AM 3 1 6
5/21/2019 10:00 AM 5 4 3
5/21/2019 10:00 AM 6 8 1
5/21/2019 10:00 AM 10 2 5
5/21/2019 10:00 AM 9 11 4
 

Excel Facts

Spell Check in Excel
Press F7 to start spell check in Excel. Be careful, by default, Excel does not check Capitalized Werds (whoops)
give this a try.

Code:
Sub t()
Dim fn As Range, gp As Range, lr As Long, ary As Variant
ary = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11)
With ActiveSheet
    lr = .Cells.Find("*", , xlValues, xlPart, xlByRows, xlPrevious).Row
    For Each gp In Range("A2:E" & lr).SpecialCells(xlCellTypeConstants).Areas
            For i = LBound(ary) To UBound(ary)
            With gp.Cells(1, 3).Resize(5, 2)
                Set fn = .Find(ary(i), , xlValues, xlWhole)
                    If fn Is Nothing Then
                        gp.Cells(5, 3).Offset(1) = ary(i)
                        gp.Cells(5, 5).Offset(1) = "Bye"
                        Exit For
                End If
            End With
        Next
    Next
End With
End Sub
 
Last edited:
Upvote 0
Thank you for the great code. Is there a way that I can create the array to contain a series of numbers from 1 to the highest team number? I have tried the following to try and dynamically create the contents of the array; but, the gp.cells(5,3).offset(1) = Myarray(i) does not populate the team number. The debug.print Myarray shows numbers 1 thru 11 which is the lowest and highest team number and correct but does not get same results as your great code.

How can I convert your “ary = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11)” to an array of one thru the highest team number because over each season the number of teams will change and not be a constant of 11.

The code that I have created to try and do this is as follows

Dim MyArray() As Variant
'Find Largest Team Number
Sheets("RawData").Activate
LargestTeamNum = Application.WorksheetFunction.Max(Range("C:D"))
'Load the Array
ReDim MyArray(LargestTeamNum)
For S1 = 1 To LargestTeamNum
MyArray(S1) = S1
Debug.Print MyArray(S1)
Next

With ActiveSheet
lr = .Cells.Find("*", , xlValues, xlPart, xlByRows, xlPrevious).Row
For Each gp In Range("A2:E" & lr).SpecialCells(xlCellTypeConstants).Areas
For i = LBound(MyArray) To UBound(MyArray)
Debug.Print MyArray(i)
With gp.Cells(1, 3).Resize(5, 2)
Set fn = .Find(MyArray(i), , xlValues, xlWhole)
If fn Is Nothing Then
gp.Cells(5, 3).Offset(1) = MyArray(i)
gp.Cells(5, 4).Offset(1) = "Bye"
Exit For
End If
End With
Next
Next
End With
 
Upvote 0
Code:
For i = LBound(MyArray) To UBound(MyArray)
            Debug.Print MyArray(i)
           [COLOR=#ff0000] With gp.Cells(1, 3).Resize(5, 2)
[/COLOR]                Set fn = .Find(MyArray(i), , xlValues, xlWhole)
                If fn Is Nothing Then
                   [COLOR=#ff0000] gp.Cells(5, 3).Offset(1) = MyArray(i)
                    gp.Cells(5, 4).Offset(1) = "Bye"
[/COLOR]                    Exit For
                End If
            End With
        Next
        Next
If you change the number of teams participating, it will change the parameters used for the Areas range. ie. 15 Teams would change the number of rows from 5 to 7 for each Area of teams scheduled, so you wouold also have to have a variable there which would be based on the number of teams.

Code:
Dim r As Long
r = Int(LargestTeamNum/2)
Then you can use

Code:
[COLOR=#ff0000]With gp.Cells(1, 3).Resize(r, 2)[/COLOR]

gp.Cells(r, 3).Offset(1) = MyArray(i)
gp.Cells(r, 4).Offset(1) = "Bye"
 
Upvote 0
I have run the following code and receive the following results.

In the load the array section, the debug.print myarrary (S1) shows the numbers 1 thru 11. In the Put the team number that has a bye in the blank row, the debug.print myarray(i) does not show any value. The if fn is nothing check falls thru to the 2 gp.cells commands. This looks like my ‘load the array is saying that the numbers 1 thru 11 are loading but the or i = LBound(MyArray) To UBound(MyArray) is not finding them. However, it I put your MyArray = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11) statement after the load my array using the ‘For S1 = 1 etc’ statement then the code in the put team number… section’ works.

How can I change the population of the array to be dynamic instead of being loaded by a comma separated set of values?

BTW, I have tested the code with a different number of teams and it works GREAT !!!!


Dim r As Long
Dim fn As Range
Dim gp As Range
Dim lr As Long
Dim MyArray() As Variant
Dim S1 As Integer
Dim LargestTeamNum As Integer

'Activate sheet to work on
Sheets("RawData").Activate

'Find Largest Team Number
LargestTeamNum = Application.WorksheetFunction.Max(Range("C:D"))

'Load the Array
ReDim MyArray(LargestTeamNum)
For S1 = 1 To LargestTeamNum
MyArray(S1) = S1
Debug.Print MyArray(S1)
Next

'Put the team number that has a bye in the blank row
' (old code is commetted out)
r = Int(LargestTeamNum / 2)
'if following population of array is used then code below works
' MyArray = Array(1, 2, 3, 4, 5, 6, 7)
With ActiveSheet
lr = .Cells.Find("*", , xlValues, xlPart, xlByRows, xlPrevious).Row
For Each gp In Range("A2:E" & lr).SpecialCells(xlCellTypeConstants).Areas
For i = LBound(MyArray) To UBound(MyArray)
Debug.Print MyArray(i)
'With gp.Cells(1, 3).Resize(5, 2)
With gp.Cells(1, 3).Resize(r, 2)
Set fn = .Find(MyArray(i), , xlValues, xlWhole)
If fn Is Nothing Then
'gp.Cells(5, 3).Offset(1) = MyArray(i)
'gp.Cells(5, 4).Offset(1) = "Bye"
gp.Cells(r, 3).Offset(1) = MyArray(i)
gp.Cells(r, 4).Offset(1) = "Bye"
Exit For
End If
End With
Next
Next
End With
 
Upvote 0
Stop the presses. I got it

Changed MyArray(S1) = S1 to MyArray(S1 - 1) = S1 because array index starts from ZERO.

My greatest admiration and thanks to JLGWIZ who has the patience of a saint. It is now off to a nap for this old retired man living in Florida trying to learn some excel/vba for our bocceball commissioner.
 
Upvote 0
Stop the presses. I got it

Changed MyArray(S1) = S1 to MyArray(S1 - 1) = S1 because array index starts from ZERO.

My greatest admiration and thanks to JLGWIZ who has the patience of a saint. It is now off to a nap for this old retired man living in Florida trying to learn some excel/vba for our bocceball commissioner.

Happy to help,
Regards, JLG
 
Upvote 0

Forum statistics

Threads
1,224,735
Messages
6,180,636
Members
452,992
Latest member
TokugawaIesuma

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