Help with VBA code error "For variable already in use"

togenmoser

togenmoser

New Member
Joined
Mar 21, 2024
Messages
19
Office Version
  1. 2016
Platform
  1. Windows
Any effort to improve or correct this code will be much appreciated. I get "For variable already in use" error.
The code is pasted below.
Thanks in advance.

Sub FindAllSumPairs()
'Declare variables
Dim ws As Worksheet
Dim rng As Range
Dim i As Long, j As Long, k As Long, m As Long, l As Long
Dim sum As Long
Dim color As Long
Dim prevColor As Long
Dim diff As Double
Dim criteria(1 To 5) As Long
Dim pairValue1 As Long, pairValue2 As Long
Dim criteriaMatch1 As Boolean, criteriaMatch2 As Boolean

'Set worksheet and range
Set ws = ActiveSheet
Set rng = ws.UsedRange 'Change this as needed

'Get criteria values from B1 to F1
For i = 1 To 5
criteria(i) = ws.Cells(1, i + 1).Value
Next i

'Loop through the target values in H1 to Q1
For i = 8 To 17
'Get the target value and a random color
sum = ws.Cells(1, i).Value
color = RGB(Int(Rnd * 256), Int(Rnd * 256), Int(Rnd * 256))

'Check if the chosen color is too close to the previous color
If i > 8 Then
'Get the previous color
prevColor = ws.Cells(1, i - 1).Interior.Color

'Calculate the difference between the two colors using Euclidean distance formula
diff = Sqr(((color Mod 256) - (prevColor Mod 256)) ^ 2 + ((color \ 256 Mod 256) - (prevColor \ 256 Mod 256)) ^ 2 + ((color \ 65536) - (prevColor \ 65536)) ^ 2)

'If the difference is less than a threshold, choose a different color
If diff < 50 Then 'Change this as needed
color = RGB(Int(Rnd * 256), Int(Rnd * 256), Int(Rnd * 256))
End If
End If

'Loop through the rows in the range
For j = 2 To rng.Rows.Count 'Start from row 2 to avoid the header
'Loop through the sets of 5 cells in the same row, separated by empty cells
For m = 1 To rng.Columns.Count Step 6
'Loop through the columns in the same set of 5 cells
For k = m To m + 4
'Loop through the remaining columns in the same set of 5 cells
For l = k + 1 To m + 4
'Check if the current cell and another cell are not empty and add up to the target value
If Not IsEmpty(rng.Cells(j, k)) And Not IsEmpty(rng.Cells(j, l)) And rng.Cells(j, k).Value + rng.Cells(j, l).Value = sum Then
pairValue1 = rng.Cells(j, k).Value
pairValue2 = rng.Cells(j, l).Value

'Reset criteria match flags
criteriaMatch1 = False
criteriaMatch2 = False

'Check against criteria for the first cell of the pair
For m = 1 To 5
If pairValue1 >= criteria(m) - 10 And pairValue1 <= criteria(m) + 10 Then
criteriaMatch1 = True
Exit For
End If
Next m

'Check against criteria for the second cell of the pair
For m = 1 To 5
If pairValue2 >= criteria(m) - 10 And pairValue2 <= criteria(m) + 10 Then
criteriaMatch2 = True
Exit For
End If
Next m

'Check if criteria values are opposite of each other
If criteriaMatch1 And Not criteriaMatch2 Then
For m = 1 To 5
If pairValue2 = criteria(m) + 10 Then
criteriaMatch2 = True
Exit For
End If
Next m
ElseIf criteriaMatch2 And Not criteriaMatch1 Then
For m = 1 To 5
If pairValue1 = criteria(m) - 10 Then
criteriaMatch1 = True
Exit For
End If
Next m
End If

'If both criteria are met, format the cells
If criteriaMatch1 And criteriaMatch2 Then
'Set the border color and thickness for the pair of cells, using all round borders
With rng.Cells(j, k).Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Color = color
.Weight = xlThick
End With

With rng.Cells(j, k).Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Color = color
.Weight = xlThick
End With

With rng.Cells(j, l).Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Color = color
.Weight = xlThick
End With

With rng.Cells(j, l).Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Color = color
.Weight = xlThick
End With

With rng.Cells(j, k).Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Color = color
.Weight = xlThick
End With

With rng.Cells(j, k).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Color = color
.Weight = xlThick
End With

With rng.Cells(j, l).Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Color = color
.Weight = xlThick
End With

With rng.Cells(j, l).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Color = color
.Weight = xlThick
End With

End If
End If
Next l
Next k
Next m
Next j
Next i
End Sub
 
Sort by date Sort by votes
togenmoser said:
Could you kindly run it at your end and help me out with the solution?
Click to expand...
If it is Subscript out of range then there is nothing running it at our end would tell us as Subscript out of range is normally a naming error, i.e. a sheet name or workbook name is written incorrectly, extra spaces before or after a name etc.

The best thing you can do is step through the code by pressing F8 and see where the code stops you.
 
Upvote 0

Excel Facts

How to change case of text in Excel?
Use =UPPER() for upper case, =LOWER() for lower case, and =PROPER() for proper case. PROPER won't capitalize second c in Mccartney
MARK858 said:
If it is Subscript out of range then there is nothing running it at our end would tell us as Subscript out of range is normally a naming error, i.e. a sheet name or workbook name is written incorrectly, extra spaces before or after a name etc.

The best thing you can do is step through the code by pressing F8 and see where the code stops you.
Click to expand...
The code stops at next m. Find the image attached
 

Attachments

  • IMG_20240402_224330_543.jpg
    IMG_20240402_224330_543.jpg
    69 KB · Views: 10
  • IMG_20240402_224357_114.jpg
    IMG_20240402_224357_114.jpg
    50.3 KB · Views: 11
Upvote 0
Can you post exactly what the error message says please
 
Upvote 0
MARK858 said:
Can you post exactly what the error message says please
Click to expand...
The error message says
"runtime error 9"
Script out of range.
I'm running the code in VB in excel so all I get is a message box with the error, exit and help buttons.
The help button only opens Microsoft webpage.
I sincerely hope someone could copy the code and help correct the errors within.
 
Upvote 0
I'm running the code below on this dataset
Book1
BCDEF
145455
22510710
313-4-344
412-3-2-17-16
511-2-1-14-13
610-101-10
7901-8-7
8812-5-4
9723-2-1
1063412
1154545
12456-58
133671011
142781314
15189-117
Sheet1


and I'm getting the below result with no error on the code

1712101460246.png


VBA Code: 
Sub FindAllSumPairs()
    'Declare variables
    Dim ws As Worksheet
    Dim rng As Range
    Dim i As Long, j As Long, k As Long, m As Long, l As Long
    Dim sum As Long, xx As Long, yy As Long, zz As Long
    Dim color As Long
    Dim prevColor As Long
    Dim diff As Double
    Dim criteria(1 To 5) As Long
    Dim pairValue1 As Long, pairValue2 As Long
    Dim criteriaMatch1 As Boolean, criteriaMatch2 As Boolean

    'Set worksheet and range
    Set ws = ActiveSheet
    Set rng = ws.UsedRange                       'Change this as needed

    'Get criteria values from B1 to F1
    For i = 1 To 5
        criteria(i) = ws.Cells(1, i + 1).Value
    Next i

    'Loop through the target values in H1 to Q1
    For i = 8 To 17
        'Get the target value and a random color
        sum = ws.Cells(1, i).Value
        color = RGB(Int(Rnd * 256), Int(Rnd * 256), Int(Rnd * 256))

        'Check if the chosen color is too close to the previous color
        If i > 8 Then
            'Get the previous color
            prevColor = ws.Cells(1, i - 1).Interior.color

            'Calculate the difference between the two colors using Euclidean distance formula
            diff = Sqr(((color Mod 256) - (prevColor Mod 256)) ^ 2 + ((color \ 256 Mod 256) - (prevColor \ 256 Mod 256)) ^ 2 + ((color \ 65536) - (prevColor \ 65536)) ^ 2)

            'If the difference is less than a threshold, choose a different color
            If diff < 50 Then                    'Change this as needed
                color = RGB(Int(Rnd * 256), Int(Rnd * 256), Int(Rnd * 256))
            End If
        End If

        'Loop through the rows in the range
        For j = 2 To rng.Rows.Count              'Start from row 2 to avoid the header
            'Loop through the sets of 5 cells in the same row, separated by empty cells
            For m = 1 To rng.Columns.Count Step 6
                'Loop through the columns in the same set of 5 cells
                For k = m To m + 4
                    'Loop through the remaining columns in the same set of 5 cells
                    For l = k + 1 To m + 4
                        'Check if the current cell and another cell are not empty and add up to the target value
                        If Not IsEmpty(rng.Cells(j, k)) And Not IsEmpty(rng.Cells(j, l)) And rng.Cells(j, k).Value + rng.Cells(j, l).Value = sum Then
                            pairValue1 = rng.Cells(j, k).Value
                            pairValue2 = rng.Cells(j, l).Value

                            'Reset criteria match flags
                            criteriaMatch1 = False
                            criteriaMatch2 = False

                            'Check against criteria for the first cell of the pair
                            For xx = 1 To 5
                                If pairValue1 >= criteria(xx) - 10 And pairValue1 <= criteria(xx) + 10 Then
                                    criteriaMatch1 = True
                                    Exit For
                                End If
                            Next xx

                            'Check against criteria for the second cell of the pair
                            For yy = 1 To 5
                                If pairValue2 >= criteria(yy) - 10 And pairValue2 <= criteria(yy) + 10 Then
                                    criteriaMatch2 = True
                                    Exit For
                                End If
                            Next yy

                            'Check if criteria values are opposite of each other
                            If criteriaMatch1 And Not criteriaMatch2 Then
                                For zz = 1 To 5
                                    If pairValue2 = criteria(zz) + 10 Then
                                        criteriaMatch2 = True
                                        Exit For
                                    End If
                                Next zz
                            ElseIf criteriaMatch2 And Not criteriaMatch1 Then
                                For zz = 1 To 5
                                    If pairValue1 = criteria(m) - 10 Then
                                        criteriaMatch1 = True
                                        Exit For
                                    End If
                                Next zz
                            End If

                            'If both criteria are met, format the cells
                            If criteriaMatch1 And criteriaMatch2 Then
                                'Set the border color and thickness for the pair of cells, using all round borders
                                With rng.Cells(j, k).Borders(xlEdgeLeft)
                                    .LineStyle = xlContinuous
                                    .color = color
                                    .Weight = xlThick
                                End With

                                With rng.Cells(j, k).Borders(xlEdgeRight)
                                    .LineStyle = xlContinuous
                                    .color = color
                                    .Weight = xlThick
                                End With

                                With rng.Cells(j, l).Borders(xlEdgeLeft)
                                    .LineStyle = xlContinuous
                                    .color = color
                                    .Weight = xlThick
                                End With

                                With rng.Cells(j, l).Borders(xlEdgeRight)
                                    .LineStyle = xlContinuous
                                    .color = color
                                    .Weight = xlThick
                                End With

                                With rng.Cells(j, k).Borders(xlEdgeTop)
                                    .LineStyle = xlContinuous
                                    .color = color
                                    .Weight = xlThick
                                End With

                                With rng.Cells(j, k).Borders(xlEdgeBottom)
                                    .LineStyle = xlContinuous
                                    .color = color
                                    .Weight = xlThick
                                End With

                                With rng.Cells(j, l).Borders(xlEdgeTop)
                                    .LineStyle = xlContinuous
                                    .color = color
                                    .Weight = xlThick
                                End With

                                With rng.Cells(j, l).Borders(xlEdgeBottom)
                                    .LineStyle = xlContinuous
                                    .color = color
                                    .Weight = xlThick
                                End With

                            End If
                        End If
                    Next l
                Next k
            Next m
        Next j
    Next i
End Sub
 
Upvote 0
If you wish to post something we can use then please use the forums XL2BB addin.

www.mrexcel.com

XL2BB - Excel Range to BBCode

Excel 'mini-sheet' in messages - XL2BB Although experts prefer to read your description and question instead of working in your actual file to solve your problem, there are times that it is difficult to explain an issue without providing actual...
www.mrexcel.com www.mrexcel.com
 
Upvote 0
Please run the code on this datasheet




DLF SAMPLE.xlsm
ABCDEFGHIJKLMNOPQRS
1188676948104258766931551347655117
2
326754164834851377121634707525
454532960563987325351302015672
52963490214782371642261944614
6726461950469434482212271889
740376976020107344124174433182
8128865637059857152903511362442
931664418454261937758076118566
10908562104984697918685577197970
117212805855881256083813491086
123516451917476462560838762368
13201518385921691637337970904140
1464778166375161365513657636816
15727780376156857368393954257560
1611437869068886657267372235663
171587407083794438423089432582
18657678572267526841276112251490
1919278441222232430158147873852
205923726255231643479565992146
21715420247515701777164243417068
2253478151037863335112962704941
2317317067752686123913630345019
24505574588125891946371735128063
2517867311216176276587990135432
263790578591540458982724990537
27622667335982731352514466608269
2849804315551201516323112563768
29486375884132875771804336805735
30757046552659242345494323864
315621827616642654415746846557
3278311311456575914123545893978
33858215687020616563826511722527
SUN. SPECIAL
Cell Formulas
RangeFormula
H1H1=SUM(B1,C1)
I1I1=SUM(B1,D1)
J1J1=SUM(B1,E1)
K1K1=SUM(B1,F1)
L1L1=SUM(C1,D1)
N1N1=SUM(C1,E1)
O1O1=SUM(C1,F1)
P1P1=SUM(D1,E1)
Q1Q1=SUM(D1,F1)
R1R1=SUM(E1,F1)
Named Ranges
NameRefers ToCells
'SUN. SPECIAL'!Print_Area='SUN. SPECIAL'!$C$1:$BC$106N1:O1, L1, H1
 
Upvote 0
Try...

VBA Code: 
Sub FindAllSumPairs()
    'Declare variables
    Dim ws As Worksheet
    Dim rng As Range
    Dim i As Long, j As Long, k As Long, m As Long, l As Long
    Dim sum As Long, xx As Long, yy As Long, zz As Long
    Dim color As Long
    Dim prevColor As Long
    Dim diff As Double
    Dim criteria(1 To 5) As Long
    Dim pairValue1 As Long, pairValue2 As Long
    Dim criteriaMatch1 As Boolean, criteriaMatch2 As Boolean

    'Set worksheet and range
    Set ws = ActiveSheet
    Set rng = ws.UsedRange                       'Change this as needed

    'Get criteria values from B1 to F1
    For i = 1 To 5
        criteria(i) = ws.Cells(1, i + 1).Value
    Next i

    'Loop through the target values in H1 to Q1
    For i = 8 To 17
        'Get the target value and a random color
        sum = ws.Cells(1, i).Value
        color = RGB(Int(Rnd * 256), Int(Rnd * 256), Int(Rnd * 256))

        'Check if the chosen color is too close to the previous color
        If i > 8 Then
            'Get the previous color
            prevColor = ws.Cells(1, i - 1).Interior.color

            'Calculate the difference between the two colors using Euclidean distance formula
            diff = Sqr(((color Mod 256) - (prevColor Mod 256)) ^ 2 + ((color \ 256 Mod 256) - (prevColor \ 256 Mod 256)) ^ 2 + ((color \ 65536) - (prevColor \ 65536)) ^ 2)

            'If the difference is less than a threshold, choose a different color
            If diff < 50 Then                    'Change this as needed
                color = RGB(Int(Rnd * 256), Int(Rnd * 256), Int(Rnd * 256))
            End If
        End If

        'Loop through the rows in the range
        For j = 2 To rng.Rows.Count              'Start from row 2 to avoid the header
            'Loop through the sets of 5 cells in the same row, separated by empty cells
            For m = 1 To rng.Columns.Count Step 6
                'Loop through the columns in the same set of 5 cells
                For k = m To m + 4
                    'Loop through the remaining columns in the same set of 5 cells
                    For l = k + 1 To m + 4
                        'Check if the current cell and another cell are not empty and add up to the target value
                        If Not IsEmpty(rng.Cells(j, k)) And Not IsEmpty(rng.Cells(j, l)) And rng.Cells(j, k).Value + rng.Cells(j, l).Value = sum Then
                            pairValue1 = rng.Cells(j, k).Value
                            pairValue2 = rng.Cells(j, l).Value

                            'Reset criteria match flags
                            criteriaMatch1 = False
                            criteriaMatch2 = False

                            'Check against criteria for the first cell of the pair
                            For xx = 1 To 5
                                If pairValue1 >= criteria(xx) - 10 And pairValue1 <= criteria(xx) + 10 Then
                                    criteriaMatch1 = True
                                    Exit For
                                End If
                            Next xx

                            'Check against criteria for the second cell of the pair
                            For yy = 1 To 5
                                If pairValue2 >= criteria(yy) - 10 And pairValue2 <= criteria(yy) + 10 Then
                                    criteriaMatch2 = True
                                    Exit For
                                End If
                            Next yy

                            'Check if criteria values are opposite of each other
                            If criteriaMatch1 And Not criteriaMatch2 Then
                                For zz = 1 To 5
                                    If pairValue2 = criteria(zz) + 10 Then
                                        criteriaMatch2 = True
                                        Exit For
                                    End If
                                Next zz
                            ElseIf criteriaMatch2 And Not criteriaMatch1 Then
                                For zz = 1 To 5
                                    If pairValue1 = criteria(zz) - 10 Then
                                        criteriaMatch1 = True
                                        Exit For
                                    End If
                                Next zz
                            End If

                            'If both criteria are met, format the cells
                            If criteriaMatch1 And criteriaMatch2 Then
                                'Set the border color and thickness for the pair of cells, using all round borders
                                With rng.Cells(j, k).Borders(xlEdgeLeft)
                                    .LineStyle = xlContinuous
                                    .color = color
                                    .Weight = xlThick
                                End With

                                With rng.Cells(j, k).Borders(xlEdgeRight)
                                    .LineStyle = xlContinuous
                                    .color = color
                                    .Weight = xlThick
                                End With

                                With rng.Cells(j, l).Borders(xlEdgeLeft)
                                    .LineStyle = xlContinuous
                                    .color = color
                                    .Weight = xlThick
                                End With

                                With rng.Cells(j, l).Borders(xlEdgeRight)
                                    .LineStyle = xlContinuous
                                    .color = color
                                    .Weight = xlThick
                                End With

                                With rng.Cells(j, k).Borders(xlEdgeTop)
                                    .LineStyle = xlContinuous
                                    .color = color
                                    .Weight = xlThick
                                End With

                                With rng.Cells(j, k).Borders(xlEdgeBottom)
                                    .LineStyle = xlContinuous
                                    .color = color
                                    .Weight = xlThick
                                End With

                                With rng.Cells(j, l).Borders(xlEdgeTop)
                                    .LineStyle = xlContinuous
                                    .color = color
                                    .Weight = xlThick
                                End With

                                With rng.Cells(j, l).Borders(xlEdgeBottom)
                                    .LineStyle = xlContinuous
                                    .color = color
                                    .Weight = xlThick
                                End With

                            End If
                        End If
                    Next l
                Next k
            Next m
        Next j
    Next i
End Sub
 
Upvote 1
Solution
T
MARK858 said:
Try...

VBA Code: 
Sub FindAllSumPairs()
    'Declare variables
    Dim ws As Worksheet
    Dim rng As Range
    Dim i As Long, j As Long, k As Long, m As Long, l As Long
    Dim sum As Long, xx As Long, yy As Long, zz As Long
    Dim color As Long
    Dim prevColor As Long
    Dim diff As Double
    Dim criteria(1 To 5) As Long
    Dim pairValue1 As Long, pairValue2 As Long
    Dim criteriaMatch1 As Boolean, criteriaMatch2 As Boolean

    'Set worksheet and range
    Set ws = ActiveSheet
    Set rng = ws.UsedRange                       'Change this as needed

    'Get criteria values from B1 to F1
    For i = 1 To 5
        criteria(i) = ws.Cells(1, i + 1).Value
    Next i

    'Loop through the target values in H1 to Q1
    For i = 8 To 17
        'Get the target value and a random color
        sum = ws.Cells(1, i).Value
        color = RGB(Int(Rnd * 256), Int(Rnd * 256), Int(Rnd * 256))

        'Check if the chosen color is too close to the previous color
        If i > 8 Then
            'Get the previous color
            prevColor = ws.Cells(1, i - 1).Interior.color

            'Calculate the difference between the two colors using Euclidean distance formula
            diff = Sqr(((color Mod 256) - (prevColor Mod 256)) ^ 2 + ((color \ 256 Mod 256) - (prevColor \ 256 Mod 256)) ^ 2 + ((color \ 65536) - (prevColor \ 65536)) ^ 2)

            'If the difference is less than a threshold, choose a different color
            If diff < 50 Then                    'Change this as needed
                color = RGB(Int(Rnd * 256), Int(Rnd * 256), Int(Rnd * 256))
            End If
        End If

        'Loop through the rows in the range
        For j = 2 To rng.Rows.Count              'Start from row 2 to avoid the header
            'Loop through the sets of 5 cells in the same row, separated by empty cells
            For m = 1 To rng.Columns.Count Step 6
                'Loop through the columns in the same set of 5 cells
                For k = m To m + 4
                    'Loop through the remaining columns in the same set of 5 cells
                    For l = k + 1 To m + 4
                        'Check if the current cell and another cell are not empty and add up to the target value
                        If Not IsEmpty(rng.Cells(j, k)) And Not IsEmpty(rng.Cells(j, l)) And rng.Cells(j, k).Value + rng.Cells(j, l).Value = sum Then
                            pairValue1 = rng.Cells(j, k).Value
                            pairValue2 = rng.Cells(j, l).Value

                            'Reset criteria match flags
                            criteriaMatch1 = False
                            criteriaMatch2 = False

                            'Check against criteria for the first cell of the pair
                            For xx = 1 To 5
                                If pairValue1 >= criteria(xx) - 10 And pairValue1 <= criteria(xx) + 10 Then
                                    criteriaMatch1 = True
                                    Exit For
                                End If
                            Next xx

                            'Check against criteria for the second cell of the pair
                            For yy = 1 To 5
                                If pairValue2 >= criteria(yy) - 10 And pairValue2 <= criteria(yy) + 10 Then
                                    criteriaMatch2 = True
                                    Exit For
                                End If
                            Next yy

                            'Check if criteria values are opposite of each other
                            If criteriaMatch1 And Not criteriaMatch2 Then
                                For zz = 1 To 5
                                    If pairValue2 = criteria(zz) + 10 Then
                                        criteriaMatch2 = True
                                        Exit For
                                    End If
                                Next zz
                            ElseIf criteriaMatch2 And Not criteriaMatch1 Then
                                For zz = 1 To 5
                                    If pairValue1 = criteria(zz) - 10 Then
                                        criteriaMatch1 = True
                                        Exit For
                                    End If
                                Next zz
                            End If

                            'If both criteria are met, format the cells
                            If criteriaMatch1 And criteriaMatch2 Then
                                'Set the border color and thickness for the pair of cells, using all round borders
                                With rng.Cells(j, k).Borders(xlEdgeLeft)
                                    .LineStyle = xlContinuous
                                    .color = color
                                    .Weight = xlThick
                                End With

                                With rng.Cells(j, k).Borders(xlEdgeRight)
                                    .LineStyle = xlContinuous
                                    .color = color
                                    .Weight = xlThick
                                End With

                                With rng.Cells(j, l).Borders(xlEdgeLeft)
                                    .LineStyle = xlContinuous
                                    .color = color
                                    .Weight = xlThick
                                End With

                                With rng.Cells(j, l).Borders(xlEdgeRight)
                                    .LineStyle = xlContinuous
                                    .color = color
                                    .Weight = xlThick
                                End With

                                With rng.Cells(j, k).Borders(xlEdgeTop)
                                    .LineStyle = xlContinuous
                                    .color = color
                                    .Weight = xlThick
                                End With

                                With rng.Cells(j, k).Borders(xlEdgeBottom)
                                    .LineStyle = xlContinuous
                                    .color = color
                                    .Weight = xlThick
                                End With

                                With rng.Cells(j, l).Borders(xlEdgeTop)
                                    .LineStyle = xlContinuous
                                    .color = color
                                    .Weight = xlThick
                                End With

                                With rng.Cells(j, l).Borders(xlEdgeBottom)
                                    .LineStyle = xlContinuous
                                    .color = color
                                    .Weight = xlThick
                                End With

                            End If
                        End If
                    Next l
                Next k
            Next m
        Next j
    Next i
End Sub
Click to expand...


Thanks very much. The code is working now but it doesn't seem to follow the set criteria entirely.
Cells u13, w13 and x13 are not within the criteria range but it's been formatted.
There are still other cells that are out of the criteria range but has been formatted.
Also how can I make it ignore cells or pairs that are exact duplicates of cells B1 to F1
 
Upvote 0
You must log in or register to reply here.

Similar threads

P
  • Question Question
Rationalise Code
Replies
1
Views
297
mumps
mumps
R
  • Question Question
VBA - AUTO FIT, Can we remove make the sum formula in below code
Replies
1
Views
157
Joe4
Joe4
K
  • Question Question
VBA DOUBT- can we add heading color and remove blank columns in this code?
Replies
0
Views
162
Kishore1982
K
G
  • Solved
Still no solution after 1 Year - Please Help
2
Replies
10
Views
781
jolivanes
jolivanes
A
  • Solved
doesn't show data in listbox on form without any error in this code
Replies
6
Views
122
Abdo
A

Forum statistics

Threads
1,223,918
Messages
6,175,365
Members
452,638
Latest member
Oluwabukunmi

Share this page

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
Back
Top