VBA run in next row until blank

Chowmann78

New Member
Joined
Dec 7, 2020
Messages
5
Office Version
  1. 365
Platform
  1. Windows
Hi,
I have uses this forum for years and for the first time can't find the exact answer I need so I am hoping someone can point me in the right direction!

This is my formula which checks a range (E4:TH15) in sheet1 and finds the color in K1 and value/text in K2 and then returns the count of these two conditions in to the cell to the left of K2.
Hope I have explained this well?

What I need is for the VBA to check all the cells in column K (K2, K3, K4....) and return the value in the adjacent left cell in each row until a blank cell is found in column K.

Sub CountColorValue()
Dim numbers As Long
Dim Cell As Range
For Each Cell In Sheet1.Range("E4:TH15")
If Cell.Interior.ColorIndex = Range("K1").Interior.ColorIndex Then
If Cell.Value Like Range("K2").Value Then
numbers = numbers + 1
End If
End If
Next Cell
Cells(2, 10).Value = numbers
End Sub

Someone has probably posted this here somewhere but I Just can't find it or figure out what I need to do.
Thanks in advance.
 

Excel Facts

How can you turn a range sideways?
Copy the range. Select a blank cell. Right-click, Paste Special, then choose Transpose.

JLGWhiz

Well-known Member
Joined
Feb 7, 2012
Messages
12,979
Office Version
  1. 2013
Platform
  1. Windows
Rich (BB code):
If Cell.Value Like Range("K2").Value Then

You are using the Like operator in the above statement. I am not sure it would work in that syntax, but without some example of what the cells in column K might contain as conmpared to the cells in Range("E4:TH15"), I am not sure what to recommend for a fix. Can you post an example of what might be in column K cells and what could be in the other range so we can see what you are trying to match up?
 

maabadi

Well-known Member
Joined
Oct 22, 2012
Messages
1,765
Office Version
  1. 2019
  2. 2016
Platform
  1. Windows
if Like arguments work correct then
Please Test this (results return at column L (column12):
VBA Code:
Sub CountColorValue()
Dim numbers As Long
Dim Cell As Range
Dim Lastrow As Long
Dim i As LongPtr

Lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To Lastrow
numbers = 0
For Each Cell In Sheet1.Range("E4:TH15")
If Cell.Interior.ColorIndex = Range("K1").Interior.ColorIndex Then
If Cell.Value Like Range("K" & i).Value Then
numbers = numbers + 1
End If
End If
Next Cell
Cells(i, 12).Value = numbers
Next i
End Sub
 
Solution

Chowmann78

New Member
Joined
Dec 7, 2020
Messages
5
Office Version
  1. 365
Platform
  1. Windows
Hi JLGWhiz,
The cells in column K are names, these names are in the range E4:TH15 on sheet1.
I am trying to count the names based on the cell color.
e.g if kerry appears 9 times with red background and 4 times with green background, the formula would return 9 in cell J2 next to the K2 cell as K1 has a red background and K2 has the text kerry.

1607362290232.png
 

maabadi

Well-known Member
Joined
Oct 22, 2012
Messages
1,765
Office Version
  1. 2019
  2. 2016
Platform
  1. Windows

ADVERTISEMENT

Sorry change
Dim i As LongPtr
to
Dim i As Long
 

Chowmann78

New Member
Joined
Dec 7, 2020
Messages
5
Office Version
  1. 365
Platform
  1. Windows
Thank you!
Works with Dim i As LongPtr.
What is the difference?
 

JLGWhiz

Well-known Member
Joined
Feb 7, 2012
Messages
12,979
Office Version
  1. 2013
Platform
  1. Windows

ADVERTISEMENT

Thank you!
Works with Dim i As LongPtr.
What is the difference?
From MS spec sheet
LongPtr is not a true data type because it transforms to a Long in 32-bit environments, or a LongLong in 64-bit environments. Using LongPtr enables writing portable code that can run in both 32-bit and 64-bit environments. Use LongPtr for pointers and handles.

Either is better than Integer.
 

maabadi

Well-known Member
Joined
Oct 22, 2012
Messages
1,765
Office Version
  1. 2019
  2. 2016
Platform
  1. Windows
From Microsoft Docs:

Note

LongPtr is not a true data type because it transforms to a Long in 32-bit environments, or a LongLong in 64-bit environments. Using LongPtr enables writing portable code that can run in both 32-bit and 64-bit environments. Use LongPtr for pointers and handles.
 

Chowmann78

New Member
Joined
Dec 7, 2020
Messages
5
Office Version
  1. 365
Platform
  1. Windows
One more question.

How do I add this to multiple columns as I have various colors to check?

Sub CountColorValue()
Dim numbers As Long
Dim Cell As Range
Dim Lastrow As Long
Dim i As LongPtr

Lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To Lastrow
numbers = 0
For Each Cell In Sheet1.Range("E4:TH15")
If Cell.Interior.ColorIndex = Range("K1").Interior.ColorIndex Then
If Cell.Value Like Range("K" & i).Value Then
numbers = numbers + 1
End If
End If
Next Cell
Cells(i, 12).Value = numbers
Next i
End Sub

Sub CountColorValue2()
Dim numbers As Long
Dim Cell As Range
Dim Lastrow As Long
Dim i As LongPtr

Lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To Lastrow
numbers = 0
For Each Cell In Sheet1.Range("E4:TH15")
If Cell.Interior.ColorIndex = Range("M1").Interior.ColorIndex Then
If Cell.Value Like Range("M" & i).Value Then
numbers = numbers + 1
End If
End If
Next Cell
Cells(i, 14).Value = numbers
Next i
End Sub

Sub CountColorValue3()
Dim numbers As Long
Dim Cell As Range
Dim Lastrow As Long
Dim i As LongPtr

Lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To Lastrow
numbers = 0
For Each Cell In Sheet1.Range("E4:TH15")
If Cell.Interior.ColorIndex = Range("O1").Interior.ColorIndex Then
If Cell.Value Like Range("O" & i).Value Then
numbers = numbers + 1
End If
End If
Next Cell
Cells(i, 16).Value = numbers
Next i
End Sub

Sub CountColorValue4()
Dim numbers As Long
Dim Cell As Range
Dim Lastrow As Long
Dim i As LongPtr

Lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To Lastrow
numbers = 0
For Each Cell In Sheet1.Range("E4:TH15")
If Cell.Interior.ColorIndex = Range("Q1").Interior.ColorIndex Then
If Cell.Value Like Range("Q" & i).Value Then
numbers = numbers + 1
End If
End If
Next Cell
Cells(i, 18).Value = numbers
Next i
End Sub
 

maabadi

Well-known Member
Joined
Oct 22, 2012
Messages
1,765
Office Version
  1. 2019
  2. 2016
Platform
  1. Windows
You can add one more for Loop for column number above For i=2 to lastrow
For Example : For j=5 to 8
and change
1. Range("K1") to Cells (1 , 2 * j + 1)
2. Range("K" & i).Value to Cells (i , 2 * j + 1).value
3. Cells(i, 12).Value to Cells(i , 2 * j + 2).Value

And add Next j after Next i
 

Watch MrExcel Video

Forum statistics

Threads
1,129,278
Messages
5,635,258
Members
416,850
Latest member
Sidddharth

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
Top