Macro help

  • Thread starter Michael Koerner
  • Start date
M

Michael Koerner

I have a macro (code below) thanks to the knowledgeble people in this NG, which goes through a table, and whenever the alpha character changes in column one it inserts a new row, merges the cells and inserts the new character centered in the new cell. The macro works great except for one problem. When the first character changes from upper case to lower case I get a new row. examples

Curwin
"new row -D-"
Deiter
"new row -d-"
deJong
"new row -D-"
Del-pivo

Below is the code which I am now using and any help is greatly appreciated, TIA

Sub InsertFramedHeadRow
' insert a framed header row into the table
'
Dim i As Long, j As Long
Dim Init As String
Dim newrow As Row
Dim initrng As Range, arange As Range
Dim dtable As Table
Set dtable = Selection.Tables(1)
j = dtable.Rows.Count
Init = dtable.Cell(j, 1).Range.Characters(1)
For i = j To 1 Step -1
Set initrng = dtable.Cell(i, 1).Range
If initrng.Characters(1) <> Init Then
Set newrow = dtable.Rows.Add(BeforeRow:=dtable.Rows(i + 1))
dtable.Split newrow
Set arange = newrow.Range
arange.Start = arange.Start - 1
arange.Collapse wdCollapseStart
arange.Paragraphs(1).Range.Font.Hidden = True
With newrow
.Cells.Merge
.Cells(1).Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
.Range.Text = "- " & Init & " -"
.Range.Font.Bold = True
.Range.Shading _
.BackgroundPatternColor = wdColorGray10
.Height = InchesToPoints(0.24)
.Borders.Enable = wdLineStyleSingle
.Borders.OutsideLineWidth = wdLineWidth100pt
End With
Init = initrng.Characters(1)
End If
Next i
Set newrow = dtable.Rows.Add(BeforeRow:=dtable.Rows(i + 1))
With newrow
.Cells.Merge
.Cells(1).Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
.Range.Text = Init
.Range.Font.Bold = True
.Range.Shading.BackgroundPatternColor = wdColorGray10
End With
End Sub
 
D

Doug Robbins - Word MVP

Change

If initrng.Characters(1) <> Init Then

to

If Ucase(initrng.Characters(1)) <> Init Then

That will force the comparison to be made between the upper case of the
first character.

You probably will also want ot change

Init = dtable.Cell(j, 1).Range.Characters(1)

to

Init = Ucase(dtable.Cell(j, 1).Range.Characters(1))

and

Init = initrng.Characters(1)

to

Init = (initrng.Characters(1))

so that all comparisons are done with the uppercase


--
Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP

I have a macro (code below) thanks to the knowledgeble people in this NG,
which goes through a table, and whenever the alpha character changes in
column one it inserts a new row, merges the cells and inserts the new
character centered in the new cell. The macro works great except for one
problem. When the first character changes from upper case to lower case I
get a new row. examples

Curwin
"new row -D-"
Deiter
"new row -d-"
deJong
"new row -D-"
Del-pivo

Below is the code which I am now using and any help is greatly appreciated,
TIA

Sub InsertFramedHeadRow
' insert a framed header row into the table
'
Dim i As Long, j As Long
Dim Init As String
Dim newrow As Row
Dim initrng As Range, arange As Range
Dim dtable As Table
Set dtable = Selection.Tables(1)
j = dtable.Rows.Count
Init = dtable.Cell(j, 1).Range.Characters(1)
For i = j To 1 Step -1
Set initrng = dtable.Cell(i, 1).Range
If initrng.Characters(1) <> Init Then
Set newrow = dtable.Rows.Add(BeforeRow:=dtable.Rows(i + 1))
dtable.Split newrow
Set arange = newrow.Range
arange.Start = arange.Start - 1
arange.Collapse wdCollapseStart
arange.Paragraphs(1).Range.Font.Hidden = True
With newrow
.Cells.Merge
.Cells(1).Range.ParagraphFormat.Alignment =
wdAlignParagraphCenter
.Range.Text = "- " & Init & " -"
.Range.Font.Bold = True
.Range.Shading _
.BackgroundPatternColor = wdColorGray10
.Height = InchesToPoints(0.24)
.Borders.Enable = wdLineStyleSingle
.Borders.OutsideLineWidth = wdLineWidth100pt
End With
Init = initrng.Characters(1)
End If
Next i
Set newrow = dtable.Rows.Add(BeforeRow:=dtable.Rows(i + 1))
With newrow
.Cells.Merge
.Cells(1).Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
.Range.Text = Init
.Range.Font.Bold = True
.Range.Shading.BackgroundPatternColor = wdColorGray10
End With
End Sub
 
G

Graham Mayor

Even with the addition of Doug's suggested changes, which overcome the
immediate problem (though there is a typo) - it should read:

Init = initrng.Characters(1)

to

Init = Ucase(initrng.Characters(1))

your macro does not format the first cell to match all the other added label
cells. In order to do that you need to add the remainder of the formatting
thus:

Dim i As Long, j As Long
Dim Init As String
Dim newrow As Row
Dim initrng As Range, arange As Range
Dim dtable As Table
Set dtable = Selection.Tables(1)
j = dtable.Rows.Count
Init = UCase(dtable.Cell(j, 1).Range.Characters(1))
For i = j To 1 Step -1
Set initrng = dtable.Cell(i, 1).Range
If UCase(initrng.Characters(1)) <> Init Then
Set newrow = dtable.Rows.Add(BeforeRow:=dtable.Rows(i + 1))
dtable.Split newrow
Set arange = newrow.Range
arange.start = arange.start - 1
arange.Collapse wdCollapseStart
arange.Paragraphs(1).Range.Font.Hidden = True
With newrow
.Cells.Merge
.Cells(1).Range.ParagraphFormat.Alignment =
wdAlignParagraphCenter
.Range.Text = "- " & Init & " -"
.Range.Font.Bold = True
.Range.Shading _
.BackgroundPatternColor = wdColorGray10
.Height = InchesToPoints(0.24)
.Borders.Enable = wdLineStyleSingle
.Borders.OutsideLineWidth = wdLineWidth100pt
End With
Init = UCase(initrng.Characters(1))
End If
Next i
Set newrow = dtable.Rows.Add(BeforeRow:=dtable.Rows(i + 1))
With newrow
.Cells.Merge
.Cells(1).Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
.Range.Text = "- " & Init & " -"
.Range.Font.Bold = True
.Range.Shading _
.BackgroundPatternColor = wdColorGray10
.Height = InchesToPoints(0.24)
.Borders.Enable = wdLineStyleSingle
.Borders.OutsideLineWidth = wdLineWidth100pt
End With


--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP


<>>< ><<> ><<> <>>< ><<> <>>< <>><<>

I have a macro (code below) thanks to the knowledgeble people in this NG,
which goes through a table, and whenever the alpha character changes in
column one it inserts a new row, merges the cells and inserts the new
character centered in the new cell. The macro works great except for one
problem. When the first character changes from upper case to lower case I
get a new row. examples

Curwin
"new row -D-"
Deiter
"new row -d-"
deJong
"new row -D-"
Del-pivo

Below is the code which I am now using and any help is greatly appreciated,
TIA

Sub InsertFramedHeadRow
' insert a framed header row into the table
'
Dim i As Long, j As Long
Dim Init As String
Dim newrow As Row
Dim initrng As Range, arange As Range
Dim dtable As Table
Set dtable = Selection.Tables(1)
j = dtable.Rows.Count
Init = dtable.Cell(j, 1).Range.Characters(1)
For i = j To 1 Step -1
Set initrng = dtable.Cell(i, 1).Range
If initrng.Characters(1) <> Init Then
Set newrow = dtable.Rows.Add(BeforeRow:=dtable.Rows(i + 1))
dtable.Split newrow
Set arange = newrow.Range
arange.Start = arange.Start - 1
arange.Collapse wdCollapseStart
arange.Paragraphs(1).Range.Font.Hidden = True
With newrow
.Cells.Merge
.Cells(1).Range.ParagraphFormat.Alignment =
wdAlignParagraphCenter
.Range.Text = "- " & Init & " -"
.Range.Font.Bold = True
.Range.Shading _
.BackgroundPatternColor = wdColorGray10
.Height = InchesToPoints(0.24)
.Borders.Enable = wdLineStyleSingle
.Borders.OutsideLineWidth = wdLineWidth100pt
End With
Init = initrng.Characters(1)
End If
Next i
Set newrow = dtable.Rows.Add(BeforeRow:=dtable.Rows(i + 1))
With newrow
.Cells.Merge
.Cells(1).Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
.Range.Text = Init
.Range.Font.Bold = True
.Range.Shading.BackgroundPatternColor = wdColorGray10
End With
End Sub
 
M

Michael Koerner

Graham;

Your absolutely correct about the first cell that was a problem. This version works like a charm now. Thank you for taking the time to help. Greatly appreciated.

--

Regards
Michael Koerner


Even with the addition of Doug's suggested changes, which overcome the
immediate problem (though there is a typo) - it should read:

Init = initrng.Characters(1)

to

Init = Ucase(initrng.Characters(1))

your macro does not format the first cell to match all the other added label
cells. In order to do that you need to add the remainder of the formatting
thus:

Dim i As Long, j As Long
Dim Init As String
Dim newrow As Row
Dim initrng As Range, arange As Range
Dim dtable As Table
Set dtable = Selection.Tables(1)
j = dtable.Rows.Count
Init = UCase(dtable.Cell(j, 1).Range.Characters(1))
For i = j To 1 Step -1
Set initrng = dtable.Cell(i, 1).Range
If UCase(initrng.Characters(1)) <> Init Then
Set newrow = dtable.Rows.Add(BeforeRow:=dtable.Rows(i + 1))
dtable.Split newrow
Set arange = newrow.Range
arange.start = arange.start - 1
arange.Collapse wdCollapseStart
arange.Paragraphs(1).Range.Font.Hidden = True
With newrow
.Cells.Merge
.Cells(1).Range.ParagraphFormat.Alignment =
wdAlignParagraphCenter
.Range.Text = "- " & Init & " -"
.Range.Font.Bold = True
.Range.Shading _
.BackgroundPatternColor = wdColorGray10
.Height = InchesToPoints(0.24)
.Borders.Enable = wdLineStyleSingle
.Borders.OutsideLineWidth = wdLineWidth100pt
End With
Init = UCase(initrng.Characters(1))
End If
Next i
Set newrow = dtable.Rows.Add(BeforeRow:=dtable.Rows(i + 1))
With newrow
.Cells.Merge
.Cells(1).Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
.Range.Text = "- " & Init & " -"
.Range.Font.Bold = True
.Range.Shading _
.BackgroundPatternColor = wdColorGray10
.Height = InchesToPoints(0.24)
.Borders.Enable = wdLineStyleSingle
.Borders.OutsideLineWidth = wdLineWidth100pt
End With


--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP


<>>< ><<> ><<> <>>< ><<> <>>< <>><<>

I have a macro (code below) thanks to the knowledgeble people in this NG,
which goes through a table, and whenever the alpha character changes in
column one it inserts a new row, merges the cells and inserts the new
character centered in the new cell. The macro works great except for one
problem. When the first character changes from upper case to lower case I
get a new row. examples

Curwin
"new row -D-"
Deiter
"new row -d-"
deJong
"new row -D-"
Del-pivo

Below is the code which I am now using and any help is greatly appreciated,
TIA

Sub InsertFramedHeadRow
' insert a framed header row into the table
'
Dim i As Long, j As Long
Dim Init As String
Dim newrow As Row
Dim initrng As Range, arange As Range
Dim dtable As Table
Set dtable = Selection.Tables(1)
j = dtable.Rows.Count
Init = dtable.Cell(j, 1).Range.Characters(1)
For i = j To 1 Step -1
Set initrng = dtable.Cell(i, 1).Range
If initrng.Characters(1) <> Init Then
Set newrow = dtable.Rows.Add(BeforeRow:=dtable.Rows(i + 1))
dtable.Split newrow
Set arange = newrow.Range
arange.Start = arange.Start - 1
arange.Collapse wdCollapseStart
arange.Paragraphs(1).Range.Font.Hidden = True
With newrow
.Cells.Merge
.Cells(1).Range.ParagraphFormat.Alignment =
wdAlignParagraphCenter
.Range.Text = "- " & Init & " -"
.Range.Font.Bold = True
.Range.Shading _
.BackgroundPatternColor = wdColorGray10
.Height = InchesToPoints(0.24)
.Borders.Enable = wdLineStyleSingle
.Borders.OutsideLineWidth = wdLineWidth100pt
End With
Init = initrng.Characters(1)
End If
Next i
Set newrow = dtable.Rows.Add(BeforeRow:=dtable.Rows(i + 1))
With newrow
.Cells.Merge
.Cells(1).Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
.Range.Text = Init
.Range.Font.Bold = True
.Range.Shading.BackgroundPatternColor = wdColorGray10
End With
End Sub
 
M

Michael Koerner

Doug;

Thanks for taking the time to help. Greatly appreciated.

--

Regards
Michael Koerner


Change

If initrng.Characters(1) <> Init Then

to

If Ucase(initrng.Characters(1)) <> Init Then

That will force the comparison to be made between the upper case of the
first character.

You probably will also want ot change

Init = dtable.Cell(j, 1).Range.Characters(1)

to

Init = Ucase(dtable.Cell(j, 1).Range.Characters(1))

and

Init = initrng.Characters(1)

to

Init = (initrng.Characters(1))

so that all comparisons are done with the uppercase


--
Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP

I have a macro (code below) thanks to the knowledgeble people in this NG,
which goes through a table, and whenever the alpha character changes in
column one it inserts a new row, merges the cells and inserts the new
character centered in the new cell. The macro works great except for one
problem. When the first character changes from upper case to lower case I
get a new row. examples

Curwin
"new row -D-"
Deiter
"new row -d-"
deJong
"new row -D-"
Del-pivo

Below is the code which I am now using and any help is greatly appreciated,
TIA

Sub InsertFramedHeadRow
' insert a framed header row into the table
'
Dim i As Long, j As Long
Dim Init As String
Dim newrow As Row
Dim initrng As Range, arange As Range
Dim dtable As Table
Set dtable = Selection.Tables(1)
j = dtable.Rows.Count
Init = dtable.Cell(j, 1).Range.Characters(1)
For i = j To 1 Step -1
Set initrng = dtable.Cell(i, 1).Range
If initrng.Characters(1) <> Init Then
Set newrow = dtable.Rows.Add(BeforeRow:=dtable.Rows(i + 1))
dtable.Split newrow
Set arange = newrow.Range
arange.Start = arange.Start - 1
arange.Collapse wdCollapseStart
arange.Paragraphs(1).Range.Font.Hidden = True
With newrow
.Cells.Merge
.Cells(1).Range.ParagraphFormat.Alignment =
wdAlignParagraphCenter
.Range.Text = "- " & Init & " -"
.Range.Font.Bold = True
.Range.Shading _
.BackgroundPatternColor = wdColorGray10
.Height = InchesToPoints(0.24)
.Borders.Enable = wdLineStyleSingle
.Borders.OutsideLineWidth = wdLineWidth100pt
End With
Init = initrng.Characters(1)
End If
Next i
Set newrow = dtable.Rows.Add(BeforeRow:=dtable.Rows(i + 1))
With newrow
.Cells.Merge
.Cells(1).Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
.Range.Text = Init
.Range.Font.Bold = True
.Range.Shading.BackgroundPatternColor = wdColorGray10
End With
End Sub
 
G

Graham Mayor

You are welcome :)

--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP


<>>< ><<> ><<> <>>< ><<> <>>< <>><<>

Graham;

Your absolutely correct about the first cell that was a problem. This
version works like a charm now. Thank you for taking the time to help.
Greatly appreciated.

--

Regards
Michael Koerner


Even with the addition of Doug's suggested changes, which overcome the
immediate problem (though there is a typo) - it should read:

Init = initrng.Characters(1)

to

Init = Ucase(initrng.Characters(1))

your macro does not format the first cell to match all the other added label
cells. In order to do that you need to add the remainder of the formatting
thus:

Dim i As Long, j As Long
Dim Init As String
Dim newrow As Row
Dim initrng As Range, arange As Range
Dim dtable As Table
Set dtable = Selection.Tables(1)
j = dtable.Rows.Count
Init = UCase(dtable.Cell(j, 1).Range.Characters(1))
For i = j To 1 Step -1
Set initrng = dtable.Cell(i, 1).Range
If UCase(initrng.Characters(1)) <> Init Then
Set newrow = dtable.Rows.Add(BeforeRow:=dtable.Rows(i + 1))
dtable.Split newrow
Set arange = newrow.Range
arange.start = arange.start - 1
arange.Collapse wdCollapseStart
arange.Paragraphs(1).Range.Font.Hidden = True
With newrow
.Cells.Merge
.Cells(1).Range.ParagraphFormat.Alignment =
wdAlignParagraphCenter
.Range.Text = "- " & Init & " -"
.Range.Font.Bold = True
.Range.Shading _
.BackgroundPatternColor = wdColorGray10
.Height = InchesToPoints(0.24)
.Borders.Enable = wdLineStyleSingle
.Borders.OutsideLineWidth = wdLineWidth100pt
End With
Init = UCase(initrng.Characters(1))
End If
Next i
Set newrow = dtable.Rows.Add(BeforeRow:=dtable.Rows(i + 1))
With newrow
.Cells.Merge
.Cells(1).Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
.Range.Text = "- " & Init & " -"
.Range.Font.Bold = True
.Range.Shading _
.BackgroundPatternColor = wdColorGray10
.Height = InchesToPoints(0.24)
.Borders.Enable = wdLineStyleSingle
.Borders.OutsideLineWidth = wdLineWidth100pt
End With


--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP


<>>< ><<> ><<> <>>< ><<> <>>< <>><<>

I have a macro (code below) thanks to the knowledgeble people in this NG,
which goes through a table, and whenever the alpha character changes in
column one it inserts a new row, merges the cells and inserts the new
character centered in the new cell. The macro works great except for one
problem. When the first character changes from upper case to lower case I
get a new row. examples

Curwin
"new row -D-"
Deiter
"new row -d-"
deJong
"new row -D-"
Del-pivo

Below is the code which I am now using and any help is greatly appreciated,
TIA

Sub InsertFramedHeadRow
' insert a framed header row into the table
'
Dim i As Long, j As Long
Dim Init As String
Dim newrow As Row
Dim initrng As Range, arange As Range
Dim dtable As Table
Set dtable = Selection.Tables(1)
j = dtable.Rows.Count
Init = dtable.Cell(j, 1).Range.Characters(1)
For i = j To 1 Step -1
Set initrng = dtable.Cell(i, 1).Range
If initrng.Characters(1) <> Init Then
Set newrow = dtable.Rows.Add(BeforeRow:=dtable.Rows(i + 1))
dtable.Split newrow
Set arange = newrow.Range
arange.Start = arange.Start - 1
arange.Collapse wdCollapseStart
arange.Paragraphs(1).Range.Font.Hidden = True
With newrow
.Cells.Merge
.Cells(1).Range.ParagraphFormat.Alignment =
wdAlignParagraphCenter
.Range.Text = "- " & Init & " -"
.Range.Font.Bold = True
.Range.Shading _
.BackgroundPatternColor = wdColorGray10
.Height = InchesToPoints(0.24)
.Borders.Enable = wdLineStyleSingle
.Borders.OutsideLineWidth = wdLineWidth100pt
End With
Init = initrng.Characters(1)
End If
Next i
Set newrow = dtable.Rows.Add(BeforeRow:=dtable.Rows(i + 1))
With newrow
.Cells.Merge
.Cells(1).Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
.Range.Text = Init
.Range.Font.Bold = True
.Range.Shading.BackgroundPatternColor = wdColorGray10
End With
End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Macro Help 4
Help needed! Extracting Heading 3 and Contents from a Word Doc to Excel 0
Exporting Data into WORD Table 2
Exporting Data into WORD Table 1
Exporting Data into WORD Table 0
Losing last line of recordset 2
Losing last Record of record set 2
Create List of all Building Blocks 1

Top