Hi numbnuts
I've added 4 lines of Code to Finish_Up...see if it works consistently for you
Sub Finish_Up()
Dim ws As Worksheet
Dim LC As Long
Dim cel As Range
Dim firstAddress As String
Dim i As Long
Dim r As Range
Dim rows As Long
Set ws = Sheets("Sheet4")
ws.Activate
With ws.Columns(1)
Set cel = .Find("Server*", LookIn:=xlValues)
If Not cel Is Nothing Then
firstAddress = cel.Address
Do
LC = Cells(cel.Row + 2, Columns.Count).End(xlToLeft).Column
If Not LC = 1 Then 'Added this line 5/29/2013
.Range(.Cells(cel.Row, cel.Column), .Cells(cel.Row, LC)).HorizontalAlignment = xlCenterAcrossSelection
With .Range(.Cells(cel.Row, cel.Column), .Cells(cel.Row, LC)).Font
.Name = "Arial"
.FontStyle = "Bold"
.Size = 8
End With
With .Range(.Cells(cel.Row, cel.Column), .Cells(cel.Row, LC)).Borders
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
For i = 1 To LC Step 2
'##############################################<--------Code Removed
' .Cells(cel.Row + 1, i + 1).Value = Split(.Cells(cel.Row + 2, i + 1), " ")(0) _
' & Split(.Cells(cel.Row + 2, i + 1), ",")(1)
'##############################################<--------Code Removed
With .Range(.Cells(cel.Row + 1, i), .Cells(cel.Row + 1, i + 1))
.HorizontalAlignment = xlCenter
.MergeCells = True
End With
With .Range(.Cells(cel.Row + 1, i), .Cells(cel.Row + 1, i + 1)).Font
.Name = "Arial"
.FontStyle = "Bold"
.Size = 8
End With
With .Range(.Cells(cel.Row + 1, i), .Cells(cel.Row + 1, i + 1)).Borders
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Next i
Else 'Added this line 5/29/2013
.Cells(cel.Row, 1).ClearContents 'Added this line 5/29/2013
End If 'Added this line 5/29/2013
Set cel = .FindNext(cel)
Loop While Not cel Is Nothing And cel.Address <> firstAddress
End If
.Range("a1:p1").EntireColumn.AutoFit
.Cells.RowHeight = 15
.Range("a1,c1,e1,g1,i1,k1,m1,o1").EntireColumn.ColumnWidth = 2.5
.Range("a1:d1").MergeCells = True
With .Range("a1")
.Font.Bold = True
.Font.Name = "Arial"
.Font.Size = 8
.Value = " Please select a Job Title:"
End With
.Range("a2:d2").MergeCells = True
.Range("a2").Select
End With
With ws
Set r = .UsedRange.Offset(4, 0)
rows = r.rows.Count
For i = rows To 1 Step (-1)
If WorksheetFunction.CountA(r.rows(i)) = 0 Then r.rows(i).Delete
Next
End With
End Sub
LinkBack URL
About LinkBacks
Register To Reply
I hope that was apparent...) -- I've learned a little about it over the course of our correspondence and to be sure, with each iteration, I've learned something new about VBA -- One of these days (hopefully sooner, rather than later), I'll be able to dedicate some time to learning how to properly use them -- speaking of which, do you have any recommendations for third party open training resources for debugging VBA, aside from the usual suspects (MSDN, Ozgrid, etc)?
Bookmarks