Public Function Comphap(Paramarray Myranges() As Variant) As String

Visual Basic text of the used macros

Public Function CompHAP(ParamArray myRanges() As Variant) As String

Dim c As Object, i As Long

Dim Hap0 As String, Hap1 As String, Comp As Boolean

Comp = True

For i = 0 To UBound(myRanges())

For Each c In myRanges(i).Cells

If c.Text > "?" Then

Hap1 = c.Text

If Hap0 = "" Then

Hap0 = Hap1

Else

Comp = Comp * (Hap0 = Hap1)

End If

Else

CompHAP = ""

GoTo out1

End If

If Not Comp Then

GoTo out2

End If

Next

Next i

out2:

CompHAP = IIf(Comp, "TRUE", "FALSE")

out1:

End Function

Public Function hap(Ch As Integer, mor As String, far As String, child As String, morORfar As Integer) As String

Dim Hap_M As String, Hap_F As String, FamGeno As String

FamGeno = Left(mor, 2) + Left(far, 2) + Left(child, 2)

Select Case FamGeno

Case "AABBAA", "AABBBB", "BBAAAA", "BBAABB", "AAAABB", "AAAAAB", "BBBBAA", "BBBBAB", "AAABBB", _

"BBABAA", "ABAABB", "ABBBAA", _

"NoBBAA", "AANoBB", "BBNoAA", "NoAABB", "NoBBAA"

Hap_M = "?"

Hap_F = "?"

Case "AAAAAA", "NoAAAA", "NoNoAA", "AANoAA", "AAABAA", "NoABAA", "ABABAA", "ABNoAA", _

"ABAAAA", "ABNoAA"

Hap_M = "A"

Hap_F = "A"

Case "AAABAB", "AANoAB", "AABBAB", "ABBBAB", "NoBBAB"

Hap_M = "A"

Hap_F = "B"

Case "BBAAAB", "BBABAB", "BBNoAB", "ABAAAB", "NoAAAB"

Hap_M = "B"

Hap_F = "A"

Case "BBBBBB", "NoBBBB", "NoNoBB", "BBNoBB", "BBABBB", "NoABBB", "ABABBB", "ABNoBB", _

"ABBBBB", "ABNoBB"

Hap_M = "B"

Hap_F = "B"

Case Else

Hap_M = "?"

Hap_F = "?"

End Select

If Ch = 23 Then Hap_F = ""

hap = IIf(morORfar = 0, Hap_M, Hap_F)

End Function

Public Sub FindHotspot()

With frmHotspots

.CommandButton1.Enabled = True

.Show

End With

End Sub

rivate Declare Function FindWindow Lib "user32" Alias _

"FindWindowA" (ByVal lpClassName As String, ByVal _

lpWindowName As String) As Long

Private Declare Function GetWindowLong Lib "user32" Alias _

"GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex _

As Long) As Long

Private Declare Function SetWindowLong Lib "user32" Alias _

"SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex _

As Long, ByVal dwNewLong As Long) As Long

Private Declare Function SendMessage Lib "user32" Alias _

"SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, _

ByVal wParam As Integer, ByVal lParam As Long) As Long

Private Declare Function DrawMenuBar Lib "user32" (ByVal _

hWnd As Long) As Long

Private wHandle As Long

Private Sub UserForm_Initialize()

On Error Resume Next

Me.Caption = "SNP tools: hotspot"

Image1.Visible = False

If Val(Application.Version) >= 9 Then

wHandle = FindWindow("ThunderDFrame", Me.Caption)

Else

wHandle = FindWindow("ThunderXFrame", Me.Caption)

End If

If wHandle = 0 Then Exit Sub

hIcon = Image1.Picture

SendMessage wHandle, &H80, True, hIcon

SendMessage wHandle, &H80, False, hIcon

frm = GetWindowLong(wHandle, -20)

frm = frm And Not &H1

SetWindowLong wHandle, -20, frm

DrawMenuBar wHandle

setStatusBar 0

With Percent

.Top = progressBar.Top

.Left = progressBar.Left

.Height = progressBar.Height

.Width = 0

.Visible = False

End With

End Sub

Private Sub CommandButton1_Click()

' CommandButton2.Enabled = True

With Me

.MousePointer = fmMousePointerHourGlass

FindHotspot1 Source:=RefEdit1, Target:=RefEdit2

.MousePointer = fmMousePointerDefault

setStatusBar 0

.Hide

End With

End Sub

'Private Sub CommandButton2_Click()

' CommandButton1.Enabled = True

' CommandButton2.Enabled = False

'End Sub

Private Sub setStatusBar(Percentage As Single)

Dim str As String

If Percentage = 0 Then 'clear and init

Progress.Visible = False

With progressBar

.Visible = False

.BorderStyle = 0

End With

With Percent

.BackColor = RGB(0, 0, 255)

.Height = progressBar.Height

.Width = 0

.BorderStyle = 0

.Visible = False

End With

Else

' setStatusBar (0)

progressBar.Visible = True

Progress.Visible = True

With Percent

.Width = Percentage * progressBar.Width

.Caption = Round(Percentage * 100, 0) & "%"

.Visible = True

End With

End If

DoEvents

End Sub

'This macro finds the break point from one region to other on the same chromosome

'usage:

'1. run the macro FindHotspot()

'2. select the data area includeing 4 columns: SNP_ID, Ch, Loction and comparisonValue

'3. tell the macro where to put result.

'4. click RUN

'Bowang Chen, DKFZ, 29.07.2004, 09.08.2004

Private Sub FindHotspot1(Source As String, Target As String)

Dim SNP(2) As New SNPData

Dim i As Long, j As Long, k As Long

Dim rowNo As Long, colNo As Long

Dim rowStart0 As Long, colStart0 As Long

Dim rowStart1 As Long, colStart1 As Long

Dim srcSheet As Worksheet, rstSheet As Worksheet

Dim srcStr As String, rstStr As String

On Error Resume Next

srcStr = Left(Source, InStr(Source, "!") - 1)

rstStr = Left(Target, InStr(Target, "!") - 1)

Set srcSheet = Sheets(srcStr)

Set rstSheet = Sheets(rstStr)

rowNo = range(Source).Rows.Count 'ËùÑ¡ÇøÓòÓм¸ÐÐ

colNo = range(Source).Count / rowNo 'ËùÑ¡ÇøÓòÓм¸ÁÐ

rowStart0 = range(Source).row 'ÆðʼÐÐ0

colStart0 = range(Source).Column 'ÆðʼÁÐ0

rowStart1 = range(Target).row 'ÆðʼÐÐ1

colStart1 = range(Target).Column 'ÆðʼÁÐ1

With rstSheet

.Cells(rowStart1, colStart1 + 0) = "SNP ID"

.Cells(rowStart1, colStart1 + 1) = "Ch"

.Cells(rowStart1, colStart1 + 2) = "Location"

End With

' With srcSheet

SNP(1).SetData _

srcSheet.Cells(rowStart0, colStart0 + 0), _

srcSheet.Cells(rowStart0, colStart0 + 1), _

srcSheet.Cells(rowStart0, colStart0 + 2), _

srcSheet.Cells(rowStart0, colStart0 + 3)

' End With

k = 1

For i = 1 To rowNo - 1

' If Not frmHotspots.CommandButton2.Enabled Then

' MsgBox "User stoped.", vbInformation + vbOKOnly, "Hotspot"

' Exit For

' End If

setStatusBar i / (rowNo - 1)

SNP(2).SetData _

srcSheet.Cells(rowStart0 + i, colStart0 + 0), _

srcSheet.Cells(rowStart0 + i, colStart0 + 1), _

srcSheet.Cells(rowStart0 + i, colStart0 + 2), _

srcSheet.Cells(rowStart0 + i, colStart0 + 3)

If (Not SNP(1).EqualComp(SNP(2))) And SNP(1).EqualCH(SNP(2)) Then

'new point found

With rstSheet

.Cells(rowStart1 + k, colStart1 + 0) = SNP(1).getSNPid 'the start point

.Cells(rowStart1 + k, colStart1 + 1) = SNP(1).getCh

.Cells(rowStart1 + k, colStart1 + 2) = SNP(1).getLoc

k = k + 1

.Cells(rowStart1 + k, colStart1 + 0) = SNP(2).getSNPid 'the end point

.Cells(rowStart1 + k, colStart1 + 1) = SNP(2).getCh

.Cells(rowStart1 + k, colStart1 + 2) = SNP(2).getLoc

k = k + 2

End With

End If

SNP(1).setDataFrom SNP(2) 'store rurrent SNP

Next i

If k > 1 Then k = k - 1

rstSheet.Select

rstSheet.range(Cells(rowStart1, colStart1), Cells(rowStart1 + k - 1, colStart1 + 2)).Select

' Selection.Copy

End Sub