I have an excel file which has around 373 NamedRanges and their values.
Some ranges are singlecell others are around multicelled value.
Now I am trying to first export the Names of the NamedRanges all of them which are present in the workbook and their values in csv format.
Then I am using the same values from the exported csv file to import the namedranges and their Values.
Now I have successfully implemented to import and export the singlecelled NamedRanges but I get error while doing the same for multicelled NamedRanges.
I tried getting some help on stackoverflow but no results yet. This is the link excel - How to import/export multicell namedrange in .csv format - Stack Overflow
<code>'This is the code to export the named ranges and their values to CSV
-----------------------------------------------------------------------------
'This one is another macro import the data from csv file.</code>
-------------------------------------------------------------------------
Any Assistance would be appreciated.
This is the link to the full file and source code incase you want to have a look
Some ranges are singlecell others are around multicelled value.
Now I am trying to first export the Names of the NamedRanges all of them which are present in the workbook and their values in csv format.
Then I am using the same values from the exported csv file to import the namedranges and their Values.
Now I have successfully implemented to import and export the singlecelled NamedRanges but I get error while doing the same for multicelled NamedRanges.
I tried getting some help on stackoverflow but no results yet. This is the link excel - How to import/export multicell namedrange in .csv format - Stack Overflow
<code>'This is the code to export the named ranges and their values to CSV
Code:
Option Explicit
Sub ExportCSV()
Dim ws As Worksheet
Dim str1 As String
Dim i As Long
Dim FinalRow As Long
Set ws = Sheets("Export")
With ws
Application.ScreenUpdating = False
ws.Activate
ws.Range("A1").Select
Selection.ListNames
FinalRow = ws.Range("B9000").End(xlUp).Row
For i = 1 To FinalRow
Cells(i, "B") = Replace(Cells(i, "B"), "$", "")
Next i
Dim fileSaveName As Variant
fileSaveName = Application.GetSaveAsFilename( _
fileFilter:="Excel Files (*.csv), *.csv")
If fileSaveName <> False Then
'Code to save the file
ws.Copy
With ActiveWorkbook
.SaveAs Filename:=fileSaveName, FileFormat:=xlCSV, CreateBackup:=False
.Close False
End With
End If
ws.Cells.Clear
End With
Worksheets("Preferences").Activate
Range("A1").Select
Application.ScreenUpdating = True
MsgBox "Data Exported Successfully at " & vbNewLine & fileSaveName, vbInformation
End Sub
-----------------------------------------------------------------------------
'This one is another macro import the data from csv file.</code>
Code:
Dim MyCSV As Workbook
Dim MyCSVPath As String
Dim MyRange As Range
Dim MyCell As Range
Dim MyNextCell As Range
Dim MyNamedRange As Range
Dim ws As Worksheet
Dim FinalRow As Long
MyCSVPath = GetFile
If MyCSVPath <> "" Then
Set MyCSV = Workbooks.Open(MyCSVPath)
Application.ScreenUpdating = False
Set ws = Sheets(1)
FinalRow = ws.Range("B90000").End(xlUp).Row
Set MyRange = MyCSV.Worksheets(1).Range("B1" & ":B" & FinalRow)
ThisWorkbook.Activate
For Each MyCell In MyRange.Cells
'Get a reference to the named range.
Set MyNamedRange = Range(ThisWorkbook.Names(MyCell.Offset(, -1).Value))
'Find the next empty cell in the named range.
Set MyNextCell = MyNamedRange.Cells(MyNamedRange.Cells.Count).End(xlUp).Offset(1)
'If the next empty cell is above the named range, then set
'it to the first cell in the range.
If MyNextCell.Row < MyNamedRange.Cells(1).Row Then
Set MyNextCell = MyNamedRange.Cells(1)
End If
'Place the value in the range.
MyNextCell = MyCell.Value
Next MyCell
End If
MyCSV.Close False
Application.ScreenUpdating = True
End Sub
'---------------------------------------------------------------------------------------
' Procedure : GetFile
' Date : 23/10/2015
' Purpose : Returns the full file path of the selected file
' To Use : vFile = GetFile()
'---------------------------------------------------------------------------------------
Function GetFile(Optional startFolder As Variant = -1) As Variant
Dim fle As FileDialog
Dim vItem As Variant
Set fle = Application.FileDialog(msoFileDialogFilePicker)
With fle
.Title = "Select a File"
.AllowMultiSelect = False
.Filters.Add "Comma Separate Values", "*.CSV", 1
If startFolder = -1 Then
.InitialFileName = Application.DefaultFilePath
Else
If Right(startFolder, 1) <> "\" Then
.InitialFileName = startFolder & "\"
Else
.InitialFileName = startFolder
End If
End If
If .Show <> -1 Then GoTo NextCode
vItem = .SelectedItems(1)
End With
NextCode:
GetFile = vItem
Set fle = Nothing
End Function
Any Assistance would be appreciated.
This is the link to the full file and source code incase you want to have a look