Auto align depending on certain text

[mfengineer]

Hi

I am working on a spreadsheet where I select a option from a dropdown list and I am hoping to find a way for certain words to auto align on the right rather than the left.
I have had a play but cannot find a way to get this working.

In the attached spreadsheet I would like the options Part, Scrap and Packaging to align on the right, all other selections I would like to keep aligning on the left.

Over time I would like to be able to add words to the dropdown list and select which ones I want on the left and which on the right.

If anyone can help I would be very grateful.

[ByteMarks]

Does this work for you?

In the code for the Alignment sheet.

It copies the alignment from the list used in the data validation.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim t As Long
Dim valRng As Range
Dim f As String

With Target
    If .Count <> 1 And Len(Target.Value) > 0 Then Exit Sub
    
    On Error Resume Next
    t = .Validation.Type
    On Error GoTo 0
    
    If t = 3 Then
        f = .Validation.Formula1
        On Error Resume Next
        Set valRng = Worksheets(Replace(Split(f, "!")(0), "=", "")).Range(Split(f, "!")(1))
        On Error GoTo 0
        
        If Not valRng Is Nothing Then
            m = Application.Match(.Value, valRng, 0)
            If Not IsError(m) Then .HorizontalAlignment = valRng.cells(m, 1).HorizontalAlignment
        End If
    End If
End With
End Sub

[mfengineer]

Thank you for the reply.
It works really well on that spreadsheet.

I have a couple of other spreadsheets that I would like to also use it on, but I cannot seem to get it to work.
I have put the same code into each of the other pages I want it to work on but the alignment does not work, although when I delete the text in the cell I get the following error message:

Run-Time error '13':

Type Mismatch

Is there something I need to change in the code for each spreadsheet?

Thank you

[ByteMarks]

Please try:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim t As Long
Dim valRng As Range
Dim f As String

With Target
    If .Count <> 1 Then Exit Sub
    If Len(.Value) = 0 Then Exit Sub
    
    On Error Resume Next
    t = .Validation.Type
    On Error GoTo 0
    
    If t = 3 Then
        f = .Validation.Formula1
        On Error Resume Next
        Set valRng = Worksheets(Replace(Split(f, "!")(0), "=", "")).Range(Split(f, "!")(1))
        On Error GoTo 0
        
        If Not valRng Is Nothing Then
            m = Application.Match(.Value, valRng, 0)
            If Not IsError(m) Then .HorizontalAlignment = valRng.Cells(m, 1).HorizontalAlignment
        End If
    End If
End With
End Sub

[mfengineer]

Thanks, this appears to have stopped the error message when clearing a cell but it is still not changing the alignment.

This is my first time using code so just want to make sure I am doing it right (guessing I am as it is working in the original sheet).

I am right clicking the tab and selecting "View code", then I am just pasting the text into the blank worksheet.

I have also tried inserting a "Module" and pasting it in there.

Thank you for your help

[ByteMarks]

right clicking the tab and selecting "View code", then I am just pasting the text into the blank worksheet.

Yes, in the sheet where the cells have data validation applied.

I have also tried inserting a "Module" and pasting it in there.

As a change event, this need to be in the worksheet that's being changed, not a module.

[ByteMarks]

If you're applying it to multiple sheets, rather than repeating this code in every sheet you can place this in the ThisWorkbook code.
Delete the code from the individual worksheets.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim t As Long
Dim valRng As Range
Dim f As String

With Target
    If .Count <> 1 Then Exit Sub
    If Len(.Value) = 0 Then Exit Sub
    
    On Error Resume Next
    t = .Validation.Type
    On Error GoTo 0
    
    If t = 3 Then
        f = .Validation.Formula1
        On Error Resume Next
        Set valRng = Worksheets(Replace(Split(f, "!")(0), "=", "")).Range(Split(f, "!")(1))
        On Error GoTo 0
        
        If Not valRng Is Nothing Then
            m = Application.Match(.Value, valRng, 0)
            If Not IsError(m) Then .HorizontalAlignment = valRng.cells(m, 1).HorizontalAlignment
        End If
    End If
End With

End Sub

[mfengineer]

I have removed the code in the individual sheet and deleted the module and inputted this code into the worksheet.

Unfortunately the alignment is still not working, I will keep playing around though.

Thanks

[ByteMarks]

This works for me.

[mfengineer]

Yeah I have got it working nicely in that workbook, but I cannot seem to get it working in my other workbooks (I have a few that differ slightly depending who they go to).
That's why I am so stumped as I can get it working on one workbook.
I am starting to go through the settings to see if something is stopping the code from activating.

[ByteMarks]

Can you post the non-working one?

[mfengineer]

Unfortunately as they are work files I am prohibited from sharing externally.