VBA Worksheet change: nested If to run sub if transposed ranges don't match.

[figment222]

I have a range of column headers that is transposed from a list in column B. When a value from column B changes, I have a macro that will copy those values and transpose them into row 8, starting with R8. I want to prevent the user from changing the column headers.

I want the column and the headers to always match. I can't run the TransposeNames macro when the column headers change because it will trigger a cascade. BUT, if I could run the TransposeNames macro when the headers change IF the changes don't match, then I can avoid the cascade.

If they change the value in the header, it will trigger the macro to make the names match again. Changing that value will trigger the macro again, but because I have it nested in an IF statement that first compares the ranges, it won't trigger the cascade because the change resulted in a match. Does that make sense?

My question is how to write the If statement to run a macro only when column B and row 8 do not match.

In case it helps, here's the script for the TransposeNames Sub:

Sub TransposeNames()
    Dim SourceRange As Range
    Dim TargetRange As Range
    
    Dim Start As Long, Final As Long
    
    Start = Range("B:B").Find("Feature Type", Range("B1")).Row
    Final = Range("B:B").Find("End", Range("B" & Start)).Row
    Set SourceRange = Range("B" & Start + 1 & ":B" & Final)
    Set TargetRange = Range("R8")
    SourceRange.Copy
    TargetRange.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, Transpose:=True
    TargetRange.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, Transpose:=True
    TargetRange.FormatConditions.Delete
    SourceRange.ClearOutline
    Range("A7").Select
End Sub

 

[figment222]

I adjusted it, but it didn't do much. When I trigger the sub, it highlights every blank value in the "grid". I'm trying to get it to highlight only values and only when those values are present in column O.

Sub HighlightCompGrid2()    
    Application.ScreenUpdating = False
    Dim Selected As Range
    Dim Grid As Range
    Dim Rng As Range, RngList As Object
    Set RngList = CreateObject("Scripting.Dictionary")
    Dim Start As Long, Final As Long, i As Long
    
    Start = Range("B:B").Find("Feature Type", Range("B1")).Row
    Final = Range("B:B").Find("End", Range("B" & Start)).Row
    i = Range("B" & Start & ":B" & Final).Count
    Set Selected = Range("O" & Start + 1 & ":O" & Final - 1)
    Set Grid = Range("R9", Range("R9").Offset(i - 3, i - 3))
    
    For Each Rng In Selected
      If Not RngList.Exists(Rng.Value) Then
        RngList.Add Rng.Value, Nothing
      End If
    Next Rng
    
    For Each Rng In Grid
      If Rng <> "" Then
        ElseIf RngList.Exists(Rng.Value) Then
      Rng.Style = "Neutral"
      End If
    Next Rng
    Set List = Nothing
    Application.ScreenUpdating = True
End Sub

 

[figment222]

Man, oh, man... after scouring the internet, I finally found some code I could modify to suit my need. It was SOOOO much simpler than what I was thinking it was going to need: For those who might be interested, here is the code:

All This does, is look in my range of columns for the values that exist in Column O and then highlight them. By the way... the application.screenupdating = False really speeds up the process of the code running. Nice tip.

Sub HighlightCompGrid()    Application.ScreenUpdating = False
    
    TransposeNames
    FillDownFormats
    'these two macros will "reset" the grid
    
    Dim FirstRow As Long, lastRow As Long, i As Long, x As Long, c As Range
    Dim Selected As Range
    Dim Grid As Range
    
    FirstRow = Range("B:B").Find("ID", Range("B1")).Row
    lastRow = Range("B:B").Find("End", Range("B8")).Row
    i = Range("B" & FirstRow & ":B" & lastRow).Count
    
    Set Grid = Range("R9", Range("R9").Offset(i - 1, i - 1))
    Set Selected = Range("O9", Range("O9").Offset(i - 1, 0))


    For Each c In Grid
        If IsNumeric(Application.Match(c, Selected, 0)) Then
            c.Style = "Neutral"
            c.Borders.LineStyle = xlContinuous
        End If
    Next c
    
    Application.ScreenUpdating = False
    
End Sub

 

[mumps]

Glad it all worked out.