Fix or touch up heading so that it could be imported by Access97
 

Hi
I have many excel spreadsheets with data need to be imported by Access97, i
need some macro to automate such job. anyone has a similar macro could help
to fix the first row of heading and give any hints or someone has done this
before could share the code? thanks

my steps probably like this:
1. select first row
2. duplicate it and trim it
3. insert formula and make it lower case, it may requre to input some
heading manually if it is empty
4. replace all special character like ()#$%,. into _

but i need help on these steps:
5. remove duplicate heading name, if the field name duplicate, it cannot be
exported
6. format those columne of figures in case it show "-" (into 0)
7. sometimes the heading contains (heading), it will show _heading_ after
conversion in step 4, how can i take it off, it seems quite weired

thanks a million..


my code but seems need more refinement:

Sub fix_heading()

Rows("1:1").Select
Selection.Copy
Selection.Insert Shift:=xlDown

Range("A1").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=LOWER(TRIM(R[1]C))"

Range("A1").Select
Selection.Copy

Range("B1").Select
Range(Selection, Selection.End(xlToRight)).Select
ActiveSheet.Paste
Application.CutCopyMode = False

Rows("1:1").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Range("A1").Select
Application.CutCopyMode = False

'replace special character
Rows("1:1").Select
' for space
Selection.Replace What:=" ", Replacement:="_", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
' for /
Selection.Replace What:="/", Replacement:="_", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
' for .
Selection.Replace What:=".", Replacement:="_", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
' for (
Selection.Replace What:="(", Replacement:="_", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
' for )
Selection.Replace What:=")", Replacement:="_", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
' for __
Selection.Replace What:="__", Replacement:="_", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

Range("A1").Select

End Sub



Leung
in HK

Fix or touch up heading so that it could be imported by Access97
 

I don't use access, so I don't know if this will work when you import it...

If you're putting arbitrary values into headers that may be duplicated, how
about just assigning non-duplicated headers to start:

Dim myRng As Range
With ActiveSheet
Set myRng = .Range("a1", .Cells(1, .Columns.Count).End(xlToLeft))
End With
With myRng
.Formula = "=lower(SUBSTITUTE(CELL(""address"",A1),""$"","""" ))"
.Value = .Value
End With

===
as for changing the - to 0's, if it's just formatting, change the formatting.
If it's a value, do another edit|replace to fix those up.


Leung wrote:

Hi
I have many excel spreadsheets with data need to be imported by Access97, i
need some macro to automate such job. anyone has a similar macro could help
to fix the first row of heading and give any hints or someone has done this
before could share the code? thanks

my steps probably like this:
1. select first row
2. duplicate it and trim it
3. insert formula and make it lower case, it may requre to input some
heading manually if it is empty
4. replace all special character like ()#$%,. into _

but i need help on these steps:
5. remove duplicate heading name, if the field name duplicate, it cannot be
exported
6. format those columne of figures in case it show "-" (into 0)
7. sometimes the heading contains (heading), it will show _heading_ after
conversion in step 4, how can i take it off, it seems quite weired

thanks a million..

my code but seems need more refinement:

Sub fix_heading()

Rows("1:1").Select
Selection.Copy
Selection.Insert Shift:=xlDown

Range("A1").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=LOWER(TRIM(R[1]C))"

Range("A1").Select
Selection.Copy

Range("B1").Select
Range(Selection, Selection.End(xlToRight)).Select
ActiveSheet.Paste
Application.CutCopyMode = False

Rows("1:1").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Range("A1").Select
Application.CutCopyMode = False

'replace special character
Rows("1:1").Select
' for space
Selection.Replace What:=" ", Replacement:="_", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
' for /
Selection.Replace What:="/", Replacement:="_", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
' for .
Selection.Replace What:=".", Replacement:="_", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
' for (
Selection.Replace What:="(", Replacement:="_", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
' for )
Selection.Replace What:=")", Replacement:="_", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
' for __
Selection.Replace What:="__", Replacement:="_", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

Range("A1").Select

End Sub

Leung
in HK

--

Dave Peterson