Public Sub FormatData()
Dim cell As Range
Dim lastrow As Long
Dim findrow As Long
Dim numrows As Long
Dim i As Long
Application.ScreenUpdating = False
Worksheets("Data").Rows(1).Insert
Call CopyData(Worksheets("Data"), "#Display Name =", Worksheets("Sheet1").Range("A1"))
Call CopyData(Worksheets("Data"), "#Sample =", Worksheets("Sheet1").Range("A2"))
Call CopyData(Worksheets("Data"), "#Medical Record =", Worksheets("Sheet1").Range("A3"))
Call CopyData(Worksheets("Data"), "#Date of Birth =", Worksheets("Sheet1").Range("A4"))
Call CopyData(Worksheets("Data"), "#Order Date =", Worksheets("Sheet1").Range("A5"))
Call CopyData(Worksheets("Data"), "#Gender =", Worksheets("Sheet1").Range("A6"))
Call CopyData(Worksheets("Data"), "#Build =", Worksheets("Sheet1").Range("A7"))
Call CopyData(Worksheets("Data"), "#SpikeIn =", Worksheets("Sheet1").Range("A8"))
Call CopyData(Worksheets("Data"), "#Location =", Worksheets("Sheet1").Range("A9"))
Call CopyData(Worksheets("Data"), "#Control Gender =", Worksheets("Sheet1").Range("A10"))
Call CopyData(Worksheets("Data"), "#Quality =", Worksheets("Sheet1").Range("A11"))
findrow = CopyData(Worksheets("Data"), "Chromosome Region", Nothing)
With Worksheets("Data")
lastrow = .Cells(findrow, "A").End(xlDown).Row
numrows = lastrow - findrow + 1
.Rows(findrow).Resize(numrows).Copy Worksheets("Sheet1").Range("A12")
End With
With Worksheets("Sheet1").Range("A12").Resize(numrows, 7)
.BorderAround LineStyle:=xlContinuous, ColorIndex:=0, Weight:=xlThin
With .Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.Weight = xlThin
End With
With .Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.Weight = xlThin
End With
End With
Worksheets("Data").Rows(1).Delete
Application.ScreenUpdating = True
End Sub
Private Function CopyData( _
ByRef From As Worksheet, _
ByVal LookFor As String, _
Optional ByRef Target As Range) As Long
Dim cell As Range
With From
Set cell = .Cells.Find(What:=LookFor, _
After:=.Range("A1"), _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)
If Not Target Is Nothing Then
cell.Copy Target
Target.Value = Right$(Target.Value, Len(Target.Value) - 1)
End If
CopyData = cell.Row
End With
End Function