add more VB exsisting

[Trevor3007]

Hi all,

I use this code:-

Private Sub Worksheet_Change(ByVal Target As Range)

Application.ScreenUpdating = False
    Dim rng As Range
       
    For Each rng In Range("a2:f100")
        Select Case rng.Value
            Case "Compliant"
                With Range("A" & rng.Row).Resize(1, 6)
                    .Interior.ColorIndex = 4
                    
                End With
                
                Case "compliant"
                With Range("A" & rng.Row).Resize(1, 6)
                    .Interior.ColorIndex = 4
                    
                End With
                                
            Case "WIP"
                With Range("A" & rng.Row).Resize(1, 6)
                    .Interior.ColorIndex = 6
                    
                    
                    End With
                                
            Case "wip"
                With Range("A" & rng.Row).Resize(1, 6)
                    .Interior.ColorIndex = 6
                    
                                       
                  
                End With
                
            Case "TBA"
                With Range("A" & rng.Row).Resize(1, 6)
                    .Interior.ColorIndex = 44
                    
                End With

                Case "tba"
                With Range("A" & rng.Row).Resize(1, 6)
                    .Interior.ColorIndex = 44
                    
                End With


            Case ""
                With Range("A" & rng.Row).Resize(1, 6)
                    .Interior.ColorIndex = xlNone
                    
                End With
        End Select
    Next rng
    


If Not (Application.Intersect(Target, Range("A2:A1000")) _
      Is Nothing) Then
        With Target
            If Not .HasFormula Then
                Application.EnableEvents = False
                .Value = UCase(.Value)
                Application.EnableEvents = True
            End If
        End With
    End If
End Sub


But want to insert this into:-
Worksheets("Sheet1").Columns("A:I").AutoFit


This is so the Columns in the range will 'Autofit' to the width of the longest data inserted .


Thank you all for your help.
KR
Trevor3007

 

[Fluff]

Do you actually have a question?

 

[Trevor3007]

Do you actually have a question?

Hi Fluff,
Hope you are safe and well
Thank you for your response.
I did have a question, which was how to add the code to some vb which I am already using.
This is the code I want to insert


But want to insert this into:-
Worksheets("Sheet1").Columns("A:I").AutoFit

The vb I use currently is at the top of my orginal thread.
Thank you, sorry for any confusion I may have cause.
Trevor3007

 

[DanteAmor]

Try this

What your code does is, every time you modify a cell anywhere on the whole sheet, it checks the value of the cells in this whole range "a2: f100" and if any of the words exists then it changes the color of the cells.
What I want to know is if that is necessary, i.e. review the entire range, or just the cell that you modified.
For example, if you modify cell Z1, your macro will review the entire range of cells from "a2: f100".

Regardless of which cells you modify, always check all cells in the "a2: f100" range.

Maybe if you explain a little more what the final objective is, we can improve your macro.

If you are fine with your macro then try the following:

Private Sub Worksheet_Change(ByVal Target As Range)
  Application.ScreenUpdating = False
  Dim rng As Range
  Range("a2:f100").Interior.ColorIndex = xlNone
  For Each rng In Range("a2:f100")
    Select Case LCase(rng.Value)
      Case LCase("Compliant")
        Range("A" & rng.Row).Resize(1, 6).Interior.ColorIndex = 4
      Case LCase("WIP")
        Range("A" & rng.Row).Resize(1, 6).Interior.ColorIndex = 6
      Case LCase("TBA")
        Range("A" & rng.Row).Resize(1, 6).Interior.ColorIndex = 44
    End Select
  Next rng

  If Not (Application.Intersect(Target, Range("A2:A1000")) Is Nothing) Then
    With Target
      If Not .HasFormula Then
        Application.EnableEvents = False
          .Value = UCase(.Value)
        Application.EnableEvents = True
      End If
    End With
  End If
  Worksheets("Sheet1").Columns("A:I").AutoFit
End Sub

 

[Trevor3007]

Try this

What your code does is, every time you modify a cell anywhere on the whole sheet, it checks the value of the cells in this whole range "a2: f100" and if any of the words exists then it changes the color of the cells.
What I want to know is if that is necessary, i.e. review the entire range, or just the cell that you modified.
For example, if you modify cell Z1, your macro will review the entire range of cells from "a2: f100".

Regardless of which cells you modify, always check all cells in the "a2: f100" range.

Maybe if you explain a little more what the final objective is, we can improve your macro.

If you are fine with your macro then try the following:

Private Sub Worksheet_Change(ByVal Target As Range)
  Application.ScreenUpdating = False
  Dim rng As Range
  Range("a2:f100").Interior.ColorIndex = xlNone
  For Each rng In Range("a2:f100")
    Select Case LCase(rng.Value)
      Case LCase("Compliant")
        Range("A" & rng.Row).Resize(1, 6).Interior.ColorIndex = 4
      Case LCase("WIP")
        Range("A" & rng.Row).Resize(1, 6).Interior.ColorIndex = 6
      Case LCase("TBA")
        Range("A" & rng.Row).Resize(1, 6).Interior.ColorIndex = 44
    End Select
  Next rng

  If Not (Application.Intersect(Target, Range("A2:A1000")) Is Nothing) Then
    With Target
      If Not .HasFormula Then
        Application.EnableEvents = False
          .Value = UCase(.Value)
        Application.EnableEvents = True
      End If
    End With
  End If
  Worksheets("Sheet1").Columns("A:I").AutoFit
End Sub

Hello DanteAmor,

Aplogees for the delay in not replying ASAP.


Thank you for your help. I think you (once again) have sorted? As I have tested & looking great sofar.

Thanks again & to all who have contact me regarding this too.
Stay safe & a great day too.

Kind regards
Trevor3007

 

[DanteAmor]

I'm glad to help you. Thanks for the feedback.