Excel VBA Course
Excel VBA Course - From Beginner to Expert

200+ Video Lessons
50+ Hours of Video
200+ Excel Guides

Become a master of VBA and Macros in Excel and learn how to automate all of your tasks in Excel with this online course. (No VBA experience required.)

View Course

VBA Help with Looping

0

Hello!

I'm trying to figure out how to loop through multiple columns headers, but in each column, I need to loop through each character in the column and recognize a specific number. If there is a match, I'd want it to highlight that column header. For example:

In the attached file starting in the 'Start Page' tab, I'd like to loop through the highlighted range (this will need to be dynamic as this range varies) and loop through the range Y1:AO1 on the 'Results' tab. The range Y1:AO1 will also need to be dynamic but will always start on Y1.

This is where to me it gets a bit more complicated: As mentioned above i want it to loop through range Y1:AO1, however first I want it to loop through each character in each cell in the range Y1:AO1. If it finds a number that matches the number in the range in the highlighted 'Start Page' tab, then I'd like it to highlight the header column in the 'Results' tab as shown. 

The code i have written so far works, but only if the numbers in the header columns in the 'Results' tab are single digits. It does not work if the columns reads 'CUMULATIVE CONTRIBUTION BY SOURCE 12' for example. I understand why because the IsNumeric function is only pulling one digit at a time, however im not sure what other route to go with this. Here is my code so far:

Sub Test2()
Dim SrcLR As Long
Dim myvalue As String
Dim i As Long
Dim a As Long
Dim number As Integer
Dim ColEnd As Integer
Dim col As Integer
Dim intstart As Integer
SrcLR = Worksheets("Start Page").Range("D" & Rows.Count).End(xlUp).Row
ColEnd = Worksheets("Results").Cells(1, Columns.Count).End(xlToLeft).Column
Worksheets("Start Page").Activate
For a = 2 To SrcLR
For col = 25 To ColEnd
  myvalue = Worksheets("Results").Cells(1, col).Value
  intstart = InStr(myvalue, "-")       'used this variable to loop only up to the "-" in myvalue

    For i = 1 To intstart
        If IsNumeric(VBA.Mid(myvalue, i, 1)) Then
        number = CInt(VBA.Mid(myvalue, i, 1))      'used this variable to make the string value into a number; otherewise loop wouldnt recongnize match with Range("D" & a).Value
            If Range("D" & a).Value = number Then
            Worksheets("Results").Cells(1, col).Interior.Color = vbYellow

            End If
         End If
    Next i
Next col
Next a

End Sub

So my question is, how do i loop through the range on 'Start Page' and Loop through each character on the 'Results' tab range, and if the numbers match, highlight the header column on the 'Results' tab? I've attached the file I'm working on which hopefully illustrates this a bit better. Any help is greatly appreciated! 

Answer
Discuss

Answers

0
Selected Answer

Cayton

In the revised file attached, I've modified your code and renamed the sub.

As the file leaves me:

  1. Row 1 of worksheet Results is shaded green (just to show it clearing then highlighting headers)
  2. the value 12 is added to column D on Start Page.

If the value in column D is 12, the code looks for strings like " 12-" and makes those headers yellow.

Some variables aren't used and the changes are in bold below:

Option Explicit

Sub test3()

    Dim SrcLR As Long
    Dim myvalue As String
    Dim i As Long
    Dim a As Long
'    Dim number As Integer ' variable not used below
    Dim ColEnd As Integer
    Dim col As Integer
'    Dim intstart As Integer ' variable not used below
    Dim Srch As String '### added this variable

    SrcLR = Worksheets("Start Page").Range("D" & Rows.Count).End(xlUp).Row

    ColEnd = Worksheets("Results").Cells(1, Columns.Count).End(xlToLeft).Column

    Worksheets("Start Page").Activate

    ' make all Results headers white
    Worksheets("Results").Rows(1).Interior.Color = vbWhite

    For a = 2 To SrcLR
        For col = 25 To ColEnd
          myvalue = Worksheets("Results").Cells(1, col).Value
          ' look for <<space + myvalue + dash>>
          Srch = InStr(myvalue, CStr(" " & Range("D" & a).Value) & "-")
          If Srch <> 0 Then
                ' if found, shade the matching header yellow
                Worksheets("Results").Cells(1, col).Interior.Color = vbYellow
                i = i + 1
          End If
        Next col
    Next a

    ' tell user
    MsgBox i & " matches made in Results; column headers shaded yellow"
End Sub

Hope this is what you want. If so, please remember to mark this Answer as Selected.

If not, please comment in the Discussion section of this Answer.

Discuss

Discussion

Thank you! That helped me out a bunch..Exactly what i was looking for 
cgreen16 (rep: 4) Dec 20, '23 at 5:05 pm
Glad you liked my solution. Thanks for selecting my Answer, Cayton. 
John_Ru (rep: 6142) Dec 20, '23 at 5:16 pm
Add to Discussion


Answer the Question

You must create an account to use the forum. Create an Account or Login