Academic Integrity: tutoring, explanations, and feedback — we don’t complete graded work or submit on a student’s behalf.

Hello, I would like to write a vba code that does the following: Say I have entr

ID: 3596605 • Letter: H

Question

Hello,

I would like to write a vba code that does the following:

Say I have entries in a column "B2" these entries are already alphabatized:

Ex.

Apples

Apples

Banana

Kiwi

Kiwi

Melon

Melon

Strawberry

I want the code to color code cells when a different entry as you go down the column is found. For instance, both Apples entries would be red and the banana entry would be blue and then kiwi entries would be red and melon entries would be blue.... etc So two colors that alternate so that I can distunguish when entries change within the column. This program should keep running until the last entry in the column.

Explanation / Answer

Sub Test1()
'Declare variables
Dim x, compare, colorvalue As Integer
Dim temp As String
  
'Stop screen from showing code execution
Application.ScreenUpdating = False
' Set numrows = number of rows of data.
NumRows = Range("B2", Range("B2").End(xlDown)).Rows.Count
' Select cell B2.
Range("B2").Select
  
'Give an initial color value
colorvalue = 5
  
'Put first cell's value in variable and give a color to it
  
temp = ActiveCell.Value
ActiveCell.Interior.ColorIndex = colorvalue
  
' Establish "For" loop to loop "numrows" number of times.
For x = 1 To NumRows - 1
  
' Selects cell down 1 row from active cell.
ActiveCell.Offset(1, 0).Select

'For next cell put its value in variable called current

current = ActiveCell.Value

'Compare if the two strings are same, if value returned equals 0 then the strings are equals
compare = StrComp(temp, current)

'Check if the strings are equal

If (compare = 0) Then

'If strings are equal put the same color as first cell
ActiveCell.Interior.ColorIndex = colorvalue
Else
'Else change the comparison string and change the value of color
temp = current
colorvalue = colorvalue + 1
ActiveCell.Interior.ColorIndex = colorvalue
  
'End if
End If
  
'Loop continues
Next
Application.ScreenUpdating = True
'End the module
End Sub

Hire Me For All Your Tutoring Needs
Integrity-first tutoring: clear explanations, guidance, and feedback.
Drop an Email at
drjack9650@gmail.com
Chat Now And Get Quote