VBA: Box a cell if value equals another cell

[Brigitta]

Hello excel gurus,

Could you help me, please, with a macro that does the following:
In the range for e.g A1:J20 it checks the cells if there are equal to cells in range A30:J30 and draws a border around the correct value.

More specific; it looks in A1:A20, finds the value that is equal to cell A30 and draws a border around it. Next column, until loops through all A:J.

The code is asigned to a button in sheet 1 and does the same for sheets 1 to 5.

Thank you for your help! I know it's quite complex...
Brigitta

 

[mumps]

Try:

Sub DelRows()
    Application.ScreenUpdating = False
    Dim rng As Range
    Dim x As Long
    For x = 1 To 10
        For Each rng In Range(Cells(1, x), Cells(20, x))
            If rng = Cells(30, x) Then
                With rng.Borders(xlEdgeLeft)
                    .LineStyle = xlContinuous
                End With
                With rng.Borders(xlEdgeTop)
                    .LineStyle = xlContinuous
                End With
                With rng.Borders(xlEdgeBottom)
                    .LineStyle = xlContinuous
                End With
                 With rng.Borders(xlEdgeRight)
                    .LineStyle = xlContinuous
                End With
            End If
        Next rng
    Next x
    Application.ScreenUpdating = True
End Sub

 

[Rick Rothstein]

Here is another macro you can try...

Sub BorderAroundRows1to20ifEqualToRow30()
  Dim C As Long
  Application.ReplaceFormat.Clear
  Application.ReplaceFormat.Borders(xlEdgeLeft).Weight = xlMedium
  Application.ReplaceFormat.Borders(xlEdgeRight).Weight = xlMedium
  Application.ReplaceFormat.Borders(xlEdgeTop).Weight = xlMedium
  Application.ReplaceFormat.Borders(xlEdgeBottom).Weight = xlMedium
  For C = 1 To 10
    Cells(1, C).Resize(20).Replace Cells(30, C).Value, "", xlWhole, , , , False, True
  Next
  Application.ReplaceFormat.Clear
End Sub

 

[mumps]

Sorry. I missed the part about the 5 sheets.

Sub DelRows()
    Application.ScreenUpdating = False
    Dim rng As Range
    Dim ws As Worksheet
    Dim mySheet As Worksheet
    Dim x As Long
    Dim y As Long
    For y = 1 To 5
        For Each ws In Sheets
            If ws.CodeName = "Sheet" & y Then
                ws.Activate
                For x = 1 To 10
                    For Each rng In Range(Cells(1, x), Cells(20, x))
                        If rng = Cells(30, x) Then
                            With rng.Borders(xlEdgeLeft)
                                .LineStyle = xlContinuous
                            End With
                            With rng.Borders(xlEdgeTop)
                                .LineStyle = xlContinuous
                            End With
                            With rng.Borders(xlEdgeBottom)
                                .LineStyle = xlContinuous
                            End With
                            With rng.Borders(xlEdgeRight)
                                .LineStyle = xlContinuous
                            End With
                        End If
                    Next rng
                Next x
            End If
        Next ws
    Next y
    Application.ScreenUpdating = True
End Sub

 

[Rick Rothstein]

Sorry. I missed the part about the 5 sheets.

Hmm, so did I...

Sub BorderAroundRows1to20ifEqualToRow30()
  Dim C As Long, WS As Long
  Application.ReplaceFormat.Clear
  Application.ReplaceFormat.Borders(xlEdgeLeft).Weight = xlMedium
  Application.ReplaceFormat.Borders(xlEdgeRight).Weight = xlMedium
  Application.ReplaceFormat.Borders(xlEdgeTop).Weight = xlMedium
  Application.ReplaceFormat.Borders(xlEdgeBottom).Weight = xlMedium
  For WS = 1 To 5
    With Sheets(WS)
      For C = 1 To 10
        .Cells(1, C).Resize(20).Replace .Cells(30, C).Value, "", xlWhole, , , , False, True
      Next
    End With
  Next
  Application.ReplaceFormat.Clear
End Sub

 

[Brigitta]

Perfect! Thank you so much!
Brigitte