Importing Text

[cranen]

I import data using a macro, and in the same macro there is code to format
the data because it can't be used in its raw form. From the formatted data,
I have named several groups of cells in order to streamline the calculation
process on another sheet. The data will probably be imported every 2-3
months. Well, when I went to test the import process against my calculation
worksheet a problem came up. Excel was changing the cells that were in the
name manager even though they included "$". Is this because of rows being
deleted in the import process? What are my options? Is there some way at
the end of the code that I could possibly name the cells? Thanks for your
time and help. Below is my code.

Sub Import_Items_List()
With
ActiveSheet.QueryTables.Add(Connection:="TEXT;X:\US_ITEMS_LIST.TXT", _
Destination:=Range("$A$1"))
.Name = "US_ITEMS_LIST_1"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlFixedWidth
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(2, 2, 2)
.TextFileFixedColumnWidths = Array(16, 17)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
Call Delete_Rows_If
End Sub
Sub Delete_Rows_If()
Dim LastRow As Long
Dim FirstRow As Long
Dim RowNdx As Long
Dim WS As Worksheet
FirstRow = 3 '<<< CHANGE AS REQUIRED
Set WS = Worksheets("IMPORT") '<<< CHANGE AS REQUIRED
With WS
LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
For RowNdx = LastRow To FirstRow Step -1
Select Case Left(.Cells(RowNdx, "B").Value, 2)
Case "00", "AC", "UN", "--"
.Rows(RowNdx).Delete Shift:=xlUp
Case Else
' do nothing
End Select
Next RowNdx
End With
Call Delete_Blanks
End Sub
Sub Delete_Blanks()
Dim rg As Range, rgBlank As Range
'-------- CHANGE HERE -----------
Set rg = ActiveSheet.Range("C:C")
'--------------------------------
'get blank cells from rg
On Error Resume Next
Set rgBlank = rg.SpecialCells(xlCellTypeBlanks)
On Error GoTo 0
If rgBlank Is Nothing Then 'no blank cell
MsgBox "No Blank cells found"
Else 'else delete entire rows
rgBlank.EntireRow.Delete
End If
Call Macro
End Sub
Sub Macro()
Dim lngRow As Long, strData As String
For lngRow = Cells(Rows.Count, "c").End(xlUp).Row To 1 Step -1
If Trim(Range("A" & lngRow)) = "" Then
strData = Trim(Range("c" & lngRow))
Rows(lngRow).Delete
lngRow = lngRow - 1
Range("C" & lngRow) = Trim(Range("C" & lngRow) & " " & strData)
strData = ""
End If
Next
End Sub

 

[Homey]

when you delet rows names do change and are supposed to change. Say you make
name "test" and it refer to =Sheet1!$A$10. then you delete row 1. Test now
refer =Sheet1!$A$9.

people sometimes make test refer to formula like: =OFFSET(Sheet1!$A$1,9,0)
or like =INDIRECT("A10") and this still refer to a10 even after row is
deleted.

but also posible to put old name back after macro delete row, like:

range("A10").Name = "test"

you have decide which best way for you.


|I import data using a macro, and in the same macro there is code to format
| the data because it can't be used in its raw form. From the formatted
data,
| I have named several groups of cells in order to streamline the
calculation
| process on another sheet. The data will probably be imported every 2-3
| months. Well, when I went to test the import process against my
calculation
| worksheet a problem came up. Excel was changing the cells that were in
the
| name manager even though they included "$". Is this because of rows being
| deleted in the import process? What are my options? Is there some way at
| the end of the code that I could possibly name the cells? Thanks for your
| time and help. Below is my code.
|
| Sub Import_Items_List()
| With
| ActiveSheet.QueryTables.Add(Connection:="TEXT;X:\US_ITEMS_LIST.TXT", _
| Destination:=Range("$A$1"))
| .Name = "US_ITEMS_LIST_1"
| .FieldNames = True
| .RowNumbers = False
| .FillAdjacentFormulas = False
| .PreserveFormatting = True
| .RefreshOnFileOpen = False
| .RefreshStyle = xlInsertDeleteCells
| .SavePassword = False
| .SaveData = True
| .AdjustColumnWidth = True
| .RefreshPeriod = 0
| .TextFilePromptOnRefresh = False
| .TextFilePlatform = 437
| .TextFileStartRow = 1
| .TextFileParseType = xlFixedWidth
| .TextFileTextQualifier = xlTextQualifierDoubleQuote
| .TextFileConsecutiveDelimiter = False
| .TextFileTabDelimiter = True
| .TextFileSemicolonDelimiter = False
| .TextFileCommaDelimiter = False
| .TextFileSpaceDelimiter = False
| .TextFileColumnDataTypes = Array(2, 2, 2)
| .TextFileFixedColumnWidths = Array(16, 17)
| .TextFileTrailingMinusNumbers = True
| .Refresh BackgroundQuery:=False
| End With
| Call Delete_Rows_If
| End Sub
| Sub Delete_Rows_If()
| Dim LastRow As Long
| Dim FirstRow As Long
| Dim RowNdx As Long
| Dim WS As Worksheet
| FirstRow = 3 '<<< CHANGE AS REQUIRED
| Set WS = Worksheets("IMPORT") '<<< CHANGE AS REQUIRED
| With WS
| LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
| For RowNdx = LastRow To FirstRow Step -1
| Select Case Left(.Cells(RowNdx, "B").Value, 2)
| Case "00", "AC", "UN", "--"
| .Rows(RowNdx).Delete Shift:=xlUp
| Case Else
| ' do nothing
| End Select
| Next RowNdx
| End With
| Call Delete_Blanks
| End Sub
| Sub Delete_Blanks()
| Dim rg As Range, rgBlank As Range
| '-------- CHANGE HERE -----------
| Set rg = ActiveSheet.Range("C:C")
| '--------------------------------
| 'get blank cells from rg
| On Error Resume Next
| Set rgBlank = rg.SpecialCells(xlCellTypeBlanks)
| On Error GoTo 0
| If rgBlank Is Nothing Then 'no blank cell
| MsgBox "No Blank cells found"
| Else 'else delete entire rows
| rgBlank.EntireRow.Delete
| End If
| Call Macro
| End Sub
| Sub Macro()
| Dim lngRow As Long, strData As String
| For lngRow = Cells(Rows.Count, "c").End(xlUp).Row To 1 Step -1
| If Trim(Range("A" & lngRow)) = "" Then
| strData = Trim(Range("c" & lngRow))
| Rows(lngRow).Delete
| lngRow = lngRow - 1
| Range("C" & lngRow) = Trim(Range("C" & lngRow) & " " & strData)
| strData = ""
| End If
| Next
| End Sub
|
|
|
|
|

 

[cranen]

I think my best option is to delete the names from the name manager in the
beginning of the code, and then at the end rename all the cell ranges. Can
you show me what I need to get it in there correctly? Thanks.