AutoGrid

[Trevor3007]

Hi

I have this code:-

Private Sub Worksheet_Change(ByVal Target As Range)

Application.ScreenUpdating = False
    Dim rng As Range
      
    For Each rng In Range("a1:h200")
        Select Case rng.Value
            Case "Build Completed"
                With Range("A" & rng.Row).Resize(1, 22)
                    .Interior.ColorIndex = 4
                    .Font.Bold = True
                End With
            Case "Swapped-Out"
                With Range("A" & rng.Row).Resize(1, 22)
                    .Interior.ColorIndex = 22
                    .Font.Bold = True
                End With
            Case "Build Started"
                With Range("A" & rng.Row).Resize(1, 22)
                    .Interior.ColorIndex = 6
                    .Font.Bold = True
                End With
            Case "Device Not Received"
                With Range("A" & rng.Row).Resize(1, 22)
                    .Interior.ColorIndex = 28
                    .Font.Bold = True
                End With
            Case "Emailed Requested For SCCM Check"
                With Range("A" & rng.Row).Resize(1, 22)
                    .Interior.ColorIndex = 38
                    .Font.Bold = True
                End With
            Case "Desktop UAD - On Hold ATM"
                With Range("A" & rng.Row).Resize(1, 22)
                    .Interior.ColorIndex = 44
                    .Font.Bold = True
                End With
            Case "Device With Build Engineer"
                With Range("A" & rng.Row).Resize(1, 22)
                    .Interior.ColorIndex = 40
                    .Font.Bold = False
                End With
            Case ""
                With Range("A" & rng.Row).Resize(1, 22)
                    .Interior.ColorIndex = xlNone
                    .Font.Bold = False
                End With
        End Select
    Next rng
    Application.ScreenUpdating = True
    
    
        
    
    
    
    
    
    If Target.Cells.Count > 1 Or Target.HasFormula Then Exit Sub



    On Error Resume Next

    If Not Intersect(Target, Range("a4:a200")) Is Nothing Then

        Application.EnableEvents = False

        Target = UCase(Target)

        Application.EnableEvents = True

    End If
      

    On Error GoTo 0


If Target.Cells.Count > 1 Or Target.HasFormula Then Exit Sub



    On Error Resume Next

    If Not Intersect(Target, Range("c4:c200")) Is Nothing Then

        Application.EnableEvents = False

        Target = StrConv(Target, vbProperCase)

        Application.EnableEvents = True

    End If

    On Error GoTo 0
    
    
    
    
     If Target.Cells.Count > 1 Or Target.HasFormula Then Exit Sub



    On Error Resume Next

    If Not Intersect(Target, Range("d4:d200")) Is Nothing Then

        Application.EnableEvents = False

        Target = LCase(Target)

        Application.EnableEvents = True

    End If
      

    On Error GoTo 0
    
    
   If Target.Cells.Count > 1 Or Target.HasFormula Then Exit Sub



    On Error Resume Next

    If Not Intersect(Target, Range("g4:g200")) Is Nothing Then

        Application.EnableEvents = False

        Target = UCase(Target)

        Application.EnableEvents = True

    End If
      

    On Error GoTo 0
  
  
  
    If Target.Cells.Count > 1 Or Target.HasFormula Then Exit Sub



    On Error Resume Next

    If Not Intersect(Target, Range("F4:F200")) Is Nothing Then

        Application.EnableEvents = False

        Target = LCase(Target)

        Application.EnableEvents = True

    End If
      

    On Error GoTo 0
    
    ActiveSheet.UsedRange.Borders.Weight = xlThick
    Dim FirstRow As Long, LastRow As Long, i As Long
    Application.EnableEvents = False
    With ActiveSheet.UsedRange
        FirstRow = .Row
        LastRow = .SpecialCells(11).Row
    End With
    For i = LastRow To FirstRow Step -1
        If WorksheetFunction.CountA(Rows(i)) = 0 Then Rows(i).Delete
    Next
    Application.EnableEvents = True

    
    
    Range("H4:H200").Select
       With Selection.Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="=Lists!$A$2:$A$9"
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With
    Range("H4").Select
    



I only want it to go to col F, but I cannot fathom how to?

Could someone show me the light?


    
 
End Sub

 

[Fluff]

I have this code:-

And ??

 

[Trevor3007]

hi fluff,

so sorry for not replying sooner. Thanks all sorted.
have a good day and stay safe.

 

[Fluff]

Glad to hear that & thanks for the feedback