Option Explicit

Function CreateOrRetrieveSheet(sheetName As String) As Worksheet
    On Error Resume Next ' Ignore errors while attempting to get sheet
    Set CreateOrRetrieveSheet = ThisWorkbook.Sheets(sheetName)
    On Error GoTo 0 ' Turn error handling back on
    
    If CreateOrRetrieveSheet Is Nothing Then
        ' Sheet does not exist, create it
        Set CreateOrRetrieveSheet = ThisWorkbook.Sheets.Add
        CreateOrRetrieveSheet.Name = sheetName
    End If
End Function

Sub ListFolderContentToSheet()
    Dim ws As Worksheet
    Set ws = CreateOrRetrieveSheet("LISTA")
    
    Dim fldr As FileDialog
    Dim sItem As String
    
    Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
    With fldr
        .Title = "Select a Folder"
        .AllowMultiSelect = False
        If .Show <> -1 Then Exit Sub
        sItem = .SelectedItems(1)
    End With
    
    ws.Cells(1, 4).Value = sItem ' Store the folder path in cell D1
    Dim rowNum As Long
    rowNum = 1
    GetFolderContentHierarchical sItem, ws, rowNum, 0
    
    ' Apply Zebra Design
    ApplyZebraDesign ws
End Sub

Sub GetFolderContentHierarchical(ByVal folderPath As String, ByVal ws As Worksheet, ByRef rowNum As Long, ByVal level As Integer)
    Dim FSO As Object
    Dim ParentFolder As Object
    Dim FolderItem As Object
    Dim FileItem As Object
    Dim indent As String
    
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set ParentFolder = FSO.GetFolder(folderPath)
    
    indent = String(level * 2, " ")
    
    ' List the folder itself
    ws.Cells(rowNum, 1).Value = indent & ParentFolder.path
    ws.Cells(rowNum, 1).Font.Bold = True
    rowNum = rowNum + 1
    
    ' List the items in the folder
    For Each FolderItem In ParentFolder.SubFolders
        GetFolderContentHierarchical FolderItem.path, ws, rowNum, level + 1
    Next FolderItem
    
    For Each FileItem In ParentFolder.Files
        If Right(FileItem.Name, 4) <> ".tmp" Then
            With ws.Cells(rowNum, 1)
                .Value = indent & FileItem.path
                .Hyperlinks.Add Anchor:=ws.Cells(rowNum, 1), Address:=FileItem.path, TextToDisplay:=FileItem.path
            End With
            ws.Cells(rowNum, 2).Value = FileItem.DateLastModified
            rowNum = rowNum + 1
        End If
    Next FileItem
End Sub

Sub MonitorFolderAndUpdateChanges()
    Dim wsLISTA As Worksheet
    Dim wsChanges As Worksheet
    Dim wsAllChanges As Worksheet
    Dim dictOriginal As Object
    Dim dictCurrent As Object
    Dim folderPath As String
    Dim cell As Range
    Dim rowNum As Long
    Dim lastRowChanges As Long
    Dim lastRowLISTA As Long
    Dim i As Long
    Dim Key As Variant ' Declare Key variable
    
    ' Initialize Worksheets
    Set wsLISTA = ThisWorkbook.Sheets("LISTA")
    Set wsChanges = CreateOrRetrieveSheet("MODIFICARI")
    Set wsAllChanges = CreateOrRetrieveSheet("ALL_CHANGES")
    
    ' Initialize Dictionaries
    Set dictOriginal = CreateObject("Scripting.Dictionary")
    Set dictCurrent = CreateObject("Scripting.Dictionary")
    
    ' Preserve existing data and colors from column C in MODIFICARI
    lastRowChanges = wsChanges.Cells(wsChanges.Rows.Count, "A").End(xlUp).Row
    Dim aryChanges() As Variant
    Dim aryColors() As Long
    
    If lastRowChanges > 0 Then
        ' Ensure there is data to process
        If wsChanges.Range("C1:C" & lastRowChanges).Cells.Count > 0 Then
            ReDim aryChanges(1 To lastRowChanges, 1 To 1) ' Properly dimension the array
            ReDim aryColors(1 To lastRowChanges)
            
            For i = 1 To lastRowChanges
                aryChanges(i, 1) = wsChanges.Cells(i, 3).Value
                aryColors(i) = wsChanges.Cells(i, 3).Interior.Color
            Next i
        End If
    End If
    
    wsChanges.Cells.Clear
    
    ' Get folder path from sheet LISTA cell D1
    folderPath = wsLISTA.Cells(1, 4).Value
    If folderPath = "" Then
        MsgBox "No folder path found in LISTA! Please run the listing first.", vbExclamation
        Exit Sub
    End If
    
    ' Populate dictionary with initial listing
    For Each cell In wsLISTA.Range("A1:A" & wsLISTA.Cells(wsLISTA.Rows.Count, "A").End(xlUp).Row)
        If cell.Value <> "" And Right(cell.Value, 1) <> "" Then
            dictOriginal(NormalizePath(cell.Value)) = cell.Offset(0, 1).Value
        End If
    Next cell
    
    ' Preserve existing data and colors from column C in LISTA
    lastRowLISTA = wsLISTA.Cells(wsLISTA.Rows.Count, "A").End(xlUp).Row
    Dim aryLISTA() As Variant
    Dim colorLISTA() As Long
    
    If lastRowLISTA > 0 Then
        If wsLISTA.Range("C1:C" & lastRowLISTA).Cells.Count > 0 Then
            ReDim aryLISTA(1 To lastRowLISTA, 1 To 1)  ' Properly dimension the array
            ReDim colorLISTA(1 To lastRowLISTA)
            
            For i = 1 To lastRowLISTA
                aryLISTA(i, 1) = wsLISTA.Cells(i, 3).Value
                colorLISTA(i) = wsLISTA.Cells(i, 3).Interior.Color
            Next i
        End If
    End If
    
    ' List current folder content in a temp worksheet
    Dim wsTemp As Worksheet
    Set wsTemp = CreateOrRetrieveSheet("TempListing")
    rowNum = 1
    GetFolderContentHierarchical folderPath, wsTemp, rowNum, 0
    
    ' Populate dictionary with current listing
    For Each cell In wsTemp.Range("A1:A" & wsTemp.Cells(wsTemp.Rows.Count, "A").End(xlUp).Row)
        If cell.Value <> "" And Right(cell.Value, 1) <> "" Then
            dictCurrent(NormalizePath(cell.Value)) = cell.Offset(0, 1).Value
        End If
    Next cell
    
    Dim rowChanges As Long
    rowChanges = 1
    wsChanges.Cells(rowChanges, 1).Value = "Path"
    wsChanges.Cells(rowChanges, 2).Value = "Change Type"
    wsChanges.Cells(rowChanges, 3).Value = "Last Modified Date"
    
    ' Find deleted files/folders
    For Each Key In dictOriginal.Keys
        If Not dictCurrent.Exists(Key) Then
            rowChanges = rowChanges + 1
            wsChanges.Cells(rowChanges, 1).Value = Key
            wsChanges.Cells(rowChanges, 2).Value = "Deleted"
            wsChanges.Cells(rowChanges, 3).Value = dictOriginal(Key)
        End If
    Next Key
    
    ' Find added and modified files/folders
    For Each Key In dictCurrent.Keys
        If Not dictOriginal.Exists(Key) Then ' New file/folder
            rowChanges = rowChanges + 1
            wsChanges.Cells(rowChanges, 1).Value = Key
            wsChanges.Cells(rowChanges, 2).Value = "Added"
            wsChanges.Cells(rowChanges, 3).Value = dictCurrent(Key)
        ElseIf dictCurrent(Key) <> dictOriginal(Key) Then ' Modified
            rowChanges = rowChanges + 1
            wsChanges.Cells(rowChanges, 1).Value = Key
            wsChanges.Cells(rowChanges, 2).Value = "Modified"
            wsChanges.Cells(rowChanges, 3).Value = dictCurrent(Key)
        End If
    Next Key
    
    ' Copy changes to ALL_CHANGES
    Dim lastRowAllChanges As Long
    lastRowAllChanges = wsAllChanges.Cells(wsAllChanges.Rows.Count, "A").End(xlUp).Row + 1
    If rowChanges > 1 Then
        wsChanges.Range("A2:C" & rowChanges).Copy wsAllChanges.Cells(lastRowAllChanges, 1)
    End If
    
    ' Clear and update LISTA sheet with current data
    wsLISTA.Cells.Clear
    wsLISTA.Cells(1, 4).Value = folderPath
    wsTemp.UsedRange.Copy wsLISTA.Cells(1, 1)

    ' Restore existing data and colors to column C in LISTA
    If lastRowLISTA > 0 Then
        For i = 1 To lastRowLISTA
            wsLISTA.Cells(i, 3).Value = aryLISTA(i, 1)
            wsLISTA.Cells(i, 3).Interior.Color = colorLISTA(i)
        Next i
    End If

    ' Restore existing data and colors to column C in MODIFICARI
    If lastRowChanges > 0 Then
        For i = 1 To lastRowChanges
            If Not IsEmpty(aryChanges(i, 1)) Then
                wsChanges.Cells(i, 3).Value = aryChanges(i, 1)
            End If
            wsChanges.Cells(i, 3).Interior.Color = aryColors(i)
        Next i
    End If

    ' Delete the temporary worksheet
    Application.DisplayAlerts = False
    wsTemp.Delete
    Application.DisplayAlerts = True
    
    ' Apply Zebra Design to LISTA and MODIFICARI sheets
    ApplyZebraDesign wsLISTA
    ApplyZebraDesign wsChanges
End Sub

Sub ApplyZebraDesign(ws As Worksheet)
    Dim lastRow As Long
    Dim rng As Range
    Dim i As Long
    
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    Set rng = ws.Range("A1:C" & lastRow)
    
    ' Clear previous formatting
    rng.Interior.ColorIndex = xlNone
    
    ' Apply zebra design
    For i = 1 To lastRow
        If i Mod 2 = 0 Then
            rng.Rows(i).Interior.Color = RGB(220, 230, 241) ' Light blue
        End If
    Next i
End Sub

Function NormalizePath(path As String) As String
    ' Function to normalize the path by removing trailing slashes and using a consistent case
    NormalizePath = LCase(Trim(path))
    If Right(NormalizePath, 1) = "" Then
        NormalizePath = Left(NormalizePath, Len(NormalizePath) - 1)
    End If
End Function

FOR THIS CODE I WANT TO KEEP BACKGROUND CELL COLOURS IN COLUMN A AFTER REFRESH AND BETEWWEN SESION