Sub ExportData()
Dim wbCurrent As Workbook, wbExport As Workbook
Dim wsCurrentMain As Worksheet, wsExportMain As Worksheet
Dim rngCurrent As Range
Dim cellUnlock As Range
Dim arrUnlock As Variant
Dim i As Long
Dim FirstCell As Range
Dim CurrCell As Range
Dim ExportDateTime As Date
Dim fnameFull As String, ExportFName As String
Dim startTime As Double
startTime = Timer
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Set wbCurrent = ThisWorkbook
Set wsCurrentMain = wbCurrent.Worksheets("Main Data") ' <--- Change this to your sheet with 29k unlocked cells
Set rngCurrent = wsCurrentMain.UsedRange
fnameFull = wbCurrent.FullName
ReDim arrUnlock(1 To rngCurrent.Cells.Count, 1 To 1)
With Application.FindFormat
.Clear
.Locked = False
End With
With rngCurrent
Set FirstCell = .Cells.Find(What:="", After:=.Cells(1, 1), _
LookIn:=xlFormulas, LookAt:=xlPart, _
SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=True)
End With
If Not FirstCell Is Nothing Then
Set CurrCell = FirstCell
i = i + 1
ExportDateTime = Now
arrUnlock(i, 1) = "Export Run: " & ExportDateTime
Do
i = i + 1
With CurrCell
arrUnlock(i, 1) = .Parent.Name & "~" & .Address(0, 0, 1, 0) & "~" & .Formula
End With
Set CurrCell = rngCurrent.Cells.Find(What:="", After:=CurrCell, _
LookIn:=xlFormulas, LookAt:=xlPart, _
SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=True)
Loop Until CurrCell.Address = FirstCell.Address
arrUnlock(1, 1) = arrUnlock(1, 1) & " ~ No of Cells: " & i - 5
Set wbExport = Workbooks.Add(xlWBATWorksheet)
Set wsExportMain = ActiveSheet
With wsExportMain
.Range("A1").Resize(i).Value = arrUnlock
.Columns(1).AutoFit
End With
With wbExport
ExportFName = Left(fnameFull, InStrRev(fnameFull, ".") - 1) & Format(ExportDateTime, "_yyyymmdd_hhmmss") & ".csv"
.SaveAs FileName:=ExportFName, FileFormat:=xlCSV
.Saved = True
.Close
End With
End If
Application.FindFormat.Clear
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
MsgBox "Duration in seconds: " & Timer - startTime
End Sub
Sub ImportData()
Dim wbCurrent As Workbook, wbImport As Workbook
Dim wsCurrentMain As Worksheet, wsImportMain As Worksheet
Dim rngCurrent As Range, rngImport As Range
Dim cellUnlock As Range
Dim arrUnlock As Variant
Dim i As Long
Dim CurrCell As Range
Dim fnameImport As String
Dim cellImport As Variant
Dim rCell As Variant
Dim startTime As Double
startTime = Timer
Set wbCurrent = ThisWorkbook
Set wsCurrentMain = wbCurrent.Worksheets("Main Data") ' <--- Change this to your sheet with 29k unlocked cells
Set rngCurrent = wsCurrentMain.UsedRange
fnameImport = Application.GetOpenFilename(FileFilter:="CSV Files,*.csv", Title:="Select file to import", MultiSelect:=False)
If fnameImport = "False" Then
MsgBox "No file selected, exiting macro"
GoTo CleanExit
End If
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Set wbImport = Workbooks.Open(FileName:=fnameImport, ReadOnly:=True)
Set wsImportMain = ActiveSheet
Set rngImport = wsImportMain.Range("A1").CurrentRegion.Columns(1)
Set rngImport = rngImport.Resize(rngImport.Rows.Count - 1).Offset(1) ' Exclude header in A1
For Each rCell In rngImport.Cells
' format = sheetname ~ cell address ~ cell content
cellImport = Split(rCell.Value, "~")
With wbCurrent
.Worksheets(cellImport(0)).Range(cellImport(1)).Formula = cellImport(2)
End With
Next rCell
wbImport.Close SaveChanges:=False
MsgBox "Duration in seconds: " & Timer - startTime
CleanExit:
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
