Repeating code until end of sheet

SuperNewToThis

New Member
Joined
Dec 23, 2017
Messages
4
Hey everyone!
So, what I want to do is essentially repeat a formula that applies to only one row of the sheet to the rest of the rows. I want to count all 999's in a single row, and print this number in a separate variable (named Grit_Tot_Miss). I want to do this for all rows in a given worksheet, no matter the number of rows there are in it (I'm going to be using it on multiple worksheets with varying amounts of rows). Here's a sample of my data:

[TABLE="width: 500"]
<tbody>[TR]
[TD]Grit1[/TD]
[TD]Grit2[/TD]
[TD]Grit3[/TD]
[TD]Grit4[/TD]
[TD]Grit5[/TD]
[TD]Grit6[/TD]
[TD]Grit7[/TD]
[TD]Grit8[/TD]
[/TR]
[TR]
[TD]5[/TD]
[TD]4[/TD]
[TD]8[/TD]
[TD]6[/TD]
[TD]7[/TD]
[TD]4[/TD]
[TD]1[/TD]
[TD]2[/TD]
[/TR]
[TR]
[TD]999[/TD]
[TD]8[/TD]
[TD]4[/TD]
[TD]5[/TD]
[TD]6[/TD]
[TD]8[/TD]
[TD]999[/TD]
[TD]999[/TD]
[/TR]
[TR]
[TD]8[/TD]
[TD]7[/TD]
[TD]5[/TD]
[TD]999[/TD]
[TD]999[/TD]
[TD]8[/TD]
[TD]7[/TD]
[TD]999[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]5[/TD]
[TD]7[/TD]
[TD]4[/TD]
[TD]6[/TD]
[TD]999[/TD]
[TD]8[/TD]
[TD]7[/TD]
[/TR]
</tbody>[/TABLE]

Also, in case you're wondering, I don't specify actual rows in my code (e.g., "A", "ZZ"), because I want to use this macro on other worksheets that may not have these headings in the same spot. For example, Grit1 may be in the AB column in one sheet, while it is in the CA column in another.

Here's my code so far:

Sub GRITTEST3()
'
' GRITTEST3 Macro
'


'
'Inputting total missing, total sum, total avg
Cells.Find(What:="Grit8", After:=[A1], LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False).Activate
ActiveCell.Offset(0, 1).EntireColumn.Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
ActiveCell.Offset(0, 1) = "Grit_Tot_Avg"
ActiveCell.Offset(0, 2) = "Grit_Tot_Sum"
ActiveCell.Offset(0, 0) = "Grit_Tot_Miss"
Cells.Find(What:="Grit_Tot_Miss", After:=[A1], LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False).Activate
'Specify range of values to caclulate formulas
Dim newRange As Range
Set newRange = Range(ActiveCell, ActiveCell.Offset(0, -8))
'Activate Missing column
Cells.Find(What:="Grit_Tot_Miss", After:=[A1], LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False).Activate
'Count missing data for grit variable
CountMissing = Application.WorksheetFunction.CountIf(newRange.Offset(1, 0), "999")
ActiveCell.Offset(1, 0) = CountMissing
End Sub

Let me know if anything is unclear. Also, if there are better ways to write the code I have written so far let me know! I'm very new to all this VBA coding, so any help is appreciated!

Thanks!
 

Excel Facts

Format cells as currency
Select range and press Ctrl+Shift+4 to format cells as currency. (Shift 4 is the $ sign).
If changed your heading to > ="Grit"&COLUMN()&" "&COUNTIF(A2:A1000,999)
 
Last edited:
Upvote 0
Hi & welcome to the board.
How about this
Code:
Sub GRITTEST3()

   Dim Usdrws As Long
   Dim Rng As Range
   Dim Fnd As Range

   Usdrws = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).row

   'Inputting total missing, total sum, total avg
   Set Fnd = Cells.Find(What:="Grit8", After:=[A1], LookIn:=xlFormulas, _
      LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
      MatchCase:=False)
   If Fnd Is Nothing Then
      MsgBox "Grit8 not found"
      Exit Sub
   End If
   Fnd.Offset(0, 1).Resize(, 3).EntireColumn.Insert
   Fnd.Offset(0, 2) = "Grit_Tot_Avg"
   Fnd.Offset(0, 3) = "Grit_Tot_Sum"
   Fnd.Offset(0, 1) = "Grit_Tot_Miss"
   'Count missing data for grit variable
   For Each Rng In Fnd.Offset(1, 1).Resize(Usdrws - Fnd.row)
      Rng.Value = Application.WorksheetFunction.CountIf(Rng.Offset(, -8).Resize(, 8), "999")
   Next Rng
End Sub
 
Upvote 0
Hi & welcome to the board.
How about this
Code:
Sub GRITTEST3()

   Dim Usdrws As Long
   Dim Rng As Range
   Dim Fnd As Range

   Usdrws = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).row

   'Inputting total missing, total sum, total avg
   Set Fnd = Cells.Find(What:="Grit8", After:=[A1], LookIn:=xlFormulas, _
      LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
      MatchCase:=False)
   If Fnd Is Nothing Then
      MsgBox "Grit8 not found"
      Exit Sub
   End If
   Fnd.Offset(0, 1).Resize(, 3).EntireColumn.Insert
   Fnd.Offset(0, 2) = "Grit_Tot_Avg"
   Fnd.Offset(0, 3) = "Grit_Tot_Sum"
   Fnd.Offset(0, 1) = "Grit_Tot_Miss"
   'Count missing data for grit variable
   For Each Rng In Fnd.Offset(1, 1).Resize(Usdrws - Fnd.row)
      Rng.Value = Application.WorksheetFunction.CountIf(Rng.Offset(, -8).Resize(, 8), "999")
   Next Rng
End Sub

Works great, thanks!!
 
Upvote 0
Glad we could help & thanks for the feedback
 
Upvote 0
Here is a non-looping macro that you can also consider...
Code:
[table="width: 500"]
[tr]
	[td]Sub GRITTEST4()
  Dim Rws As String, Cols As String, Grit8 As Range
  Set Grit8 = Cells.Find("Grit8", , , xlWhole, , , False, , False)
  If Grit8 Is Nothing Then
    MsgBox "Grit8 not found"
  Else
    Rws = Grit8.Offset(1).Row & ":" & Cells(Rows.Count, Grit8.Column).End(xlUp).Row
    Cols = Range(Grit8.Offset(, -7), Grit8).EntireColumn.Address(0, 0)
    Grit8.Offset(, 1).Resize(, 3).EntireColumn.Insert
    Grit8.Offset(, 1).Resize(, 3) = Array("Grit_Tot_Miss", "Grit_Tot_Sum", "Grit_Tot_Avg")
    With Intersect(Grit8.Offset(, 1).EntireColumn, Range(Rws))
      .FormulaArray = "=COUNTIF(OFFSET(" & Evaluate("1:1 " & Cols).Address(0, 0) & ",ROW(" & Rws & ")-1,0),999)"
      .Value = .Value
    End With
  End If
End Sub[/td]
[/tr]
[/table]
 
Last edited:
Upvote 0

Forum statistics

Threads
1,224,823
Messages
6,181,177
Members
453,021
Latest member
Justyna P

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