Attribute VB_Name = "TranslateSheet"
Option Explicit

' Translate the active sheet into a new sheet using =TRANSLATE()
Public Sub TranslateActiveSheetToNewSheet()
    Dim srcWs As Worksheet
    Set srcWs = ActiveSheet

    Debug.Print "=== TranslateActiveSheetToNewSheet START ==="
    Debug.Print "Source sheet: " & srcWs.Name

    If Not HasTranslateFunction() Then
        Debug.Print "[ERR] TRANSLATE() is not available in this Excel build (likely #NAME?). Aborting."
        Debug.Print "Tip: Update Excel / try Microsoft 365 Insider channels if you need this function."
        Debug.Print "=== ABORT ==="
        Exit Sub
    End If

    Dim fromLang As String, toLang As String, newName As String

    fromLang = InputBox( _
        "Source language code (leave blank for auto-detect)." & vbCrLf & _
        "Examples: en, ja, ko, fr, de, zh-Hans, zh-Hant", _
        "Source Language", "")

    toLang = InputBox( _
        "Target language code (required)." & vbCrLf & _
        "Examples: en, ja, ko, fr, de, zh-Hans, zh-Hant", _
        "Target Language", "en")

    If Len(Trim$(toLang)) = 0 Then
        Debug.Print "[ERR] Target language is empty. Aborting."
        Exit Sub
    End If

    newName = InputBox( _
        "New sheet name (optional). Leave blank to auto-generate.", _
        "Output Sheet Name", srcWs.Name & "_translated")

    If Len(Trim$(newName)) = 0 Then newName = srcWs.Name & "_translated"

    Dim makeValues As VbMsgBoxResult
    makeValues = MsgBox( _
        "After inserting TRANSLATE() formulas, convert results to VALUES?" & vbCrLf & _
        "(Yes = values, No = keep formulas)", _
        vbYesNoCancel + vbQuestion, "Output as values?")

    If makeValues = vbCancel Then
        Debug.Print "[INFO] User cancelled."
        Exit Sub
    End If

    Application.ScreenUpdating = False
    Application.EnableEvents = False

    ' Create output sheet as a copy (preserves formatting/layout)
    srcWs.Copy After:=srcWs
    Dim outWs As Worksheet
    Set outWs = ActiveSheet

    newName = MakeUniqueSheetName(newName)
    On Error Resume Next
    outWs.Name = newName
    On Error GoTo 0

    Debug.Print "Output sheet: " & outWs.Name

    Dim sep As String
    sep = Application.International(xlListSeparator) ' comma vs semicolon locales

    Dim textCells As Range
    On Error Resume Next
    Set textCells = srcWs.UsedRange.SpecialCells(xlCellTypeConstants, xlTextValues)
    On Error GoTo 0

    If textCells Is Nothing Then
        Debug.Print "[INFO] No text constants found. Nothing to translate."
        GoTo Finish
    End If

    Dim srcSheetRef As String
    srcSheetRef = QuoteSheetName(srcWs.Name)

    Dim c As Range
    Dim nTotal As Long, nOk As Long, nErr As Long
    nTotal = textCells.Cells.Count

    Debug.Print "Text constant cells to translate: " & nTotal
    Debug.Print "fromLang=[" & fromLang & "] toLang=[" & toLang & "]"

    For Each c In textCells.Cells
        On Error GoTo CellFail

        Dim addr As String
        addr = c.Address(False, False)

        Dim f As String
        f = BuildTranslateFormula(srcSheetRef & "!" & addr, sep, fromLang, toLang)

        outWs.Range(addr).Formula = f

        nOk = nOk + 1
        If (nOk Mod 200) = 0 Then
            Debug.Print "[PROGRESS] " & nOk & " / " & nTotal
            DoEvents
        End If

        GoTo ContinueLoop

CellFail:
        nErr = nErr + 1
        Debug.Print "[ERR] Cell " & srcWs.Name & "!" & addr & " | " & Err.Number & " - " & Err.Description
        Err.Clear

ContinueLoop:
        On Error GoTo 0
    Next c

    Debug.Print "Inserted TRANSLATE() formulas. ok=" & nOk & ", errors=" & nErr

    ' Calculate to fetch translations
    Application.Calculate

    If makeValues = vbYes Then
        Debug.Print "Converting translated cells to values..."
        For Each c In textCells.Cells
            Dim a As String
            a = c.Address(False, False)

            If outWs.Range(a).HasFormula Then
                If Not IsError(outWs.Range(a).Value2) Then
                    outWs.Range(a).Value2 = outWs.Range(a).Value2
                Else
                    Debug.Print "[WARN] Output cell " & outWs.Name & "!" & a & " still error: " & outWs.Range(a).Text
                End If
            End If
        Next c
        Debug.Print "Value conversion finished."
    End If

Finish:
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Debug.Print "=== TranslateActiveSheetToNewSheet END ==="
End Sub

' --- Helpers ---

Private Function BuildTranslateFormula(ByVal cellRef As String, ByVal sep As String, ByVal fromLang As String, ByVal toLang As String) As String
    If Len(Trim$(fromLang)) = 0 Then
        BuildTranslateFormula = "=TRANSLATE(" & cellRef & sep & sep & Quote(toLang) & ")"
    Else
        BuildTranslateFormula = "=TRANSLATE(" & cellRef & sep & Quote(fromLang) & sep & Quote(toLang) & ")"
    End If
End Function

Private Function Quote(ByVal s As String) As String
    Quote = """" & Replace(s, """", """""") & """"
End Function

Private Function QuoteSheetName(ByVal sheetName As String) As String
    QuoteSheetName = "'" & Replace(sheetName, "'", "''") & "'"
End Function

Private Function HasTranslateFunction() As Boolean
    On Error GoTo Nope
    Dim v As Variant
    v = Application.Evaluate("=TRANSLATE(""Hello"",""en"",""es"")")
    HasTranslateFunction = Not IsError(v)
    Exit Function
Nope:
    HasTranslateFunction = False
End Function

Private Function MakeUniqueSheetName(ByVal baseName As String) As String
    Dim nameTry As String
    nameTry = baseName

    Dim i As Long
    i = 1

    Do While SheetExists(nameTry)
        i = i + 1
        nameTry = Left$(baseName, 28) & "_" & CStr(i)
    Loop

    MakeUniqueSheetName = nameTry
End Function

Private Function SheetExists(ByVal sheetName As String) As Boolean
    On Error Resume Next
    SheetExists = Not ThisWorkbook.Worksheets(sheetName) Is Nothing
    On Error GoTo 0
End Function