B
Brett Smith
I have created a Macro that formats the fields of a worksheet and then
exports it into a txt file. My problem is it displays the information coming
from the N and M fields, but if there is nothing in the N field, it doesn't
display the information from the M field either. What I need is if there is
any information coming from either one, it should show up in the exported
text file? Why is information not being displayed if one of the fields is
missing in the export? Below is the code.
Sub GetRows()
Dim FirstCell As Range, LastCell As Range
On Error Resume Next
Dim Firstrow As Long, Lastrow As Long
Dim Wordstring As String
Dim filePath As String
Dim I As Integer
Dim FName As Variant
Dim Rangecount As Integer
Dim intresult As Long
Dim NVariable As String
Dim MVariable As String
Dim AVariable As String
Dim AVARSTRING As String
Dim FVariable As String
Dim FVARSTRING As String
Dim EVariable As String
Dim EVARSTRING As String
Dim NandMVariable As String
Dim NANDMVARSTRING As String
Kill (filePath = ActiveWorkbook.Path & "\Seqfile.rdf")
Worksheets.Select
Call FormatData
I = 0
Tried = False
Tried2 = False
Wordstring = "$RDFILE 1" & vbCrLf & _
"$DATM " & Date & " " & Time & vbCrLf & _
"$RIREG 1" & vbCrLf & _
"$DTYPE BATCH:CHEMIST" & vbCrLf & _
"$DATUM REIDHAAJ" & vbCrLf & _
"$DTYPE BATCH:STRUCT_CMNT" & vbCrLf & _
"$DATUM [NUCLEIC ACID]" & vbCrLf & _
"$DTYPE STRUCTURE" & vbCrLf & _
"$DATUM $MFMT"
filePath = ActiveWorkbook.Path & "\Seqfile.rdf"
Open filePath For Output As #1
Print #1, Wordstring
Do
GetCell:
On Error Resume Next
Set FirstCell = Application.InputBox("Enter top left data cell - ONE
cell only ", Type:=8)
On Error GoTo 0
If FirstCell Is Nothing Then
MsgBox "You pressed Cancel!" & IIf(Tried, "AGAIN! Good-bye!", "!")
If Tried Then Exit Sub
Tried = True
GoTo GetCell
Else
MsgBox FirstCell.Address
End If
Loop Until FirstCell.Count = 1
Firstrow = FirstCell.Row
Do
GetCell2:
On Error Resume Next
Set LastCell = Application.InputBox("Enter bottom right data cell - ONE
cellonly ", Type:=8)
On Error GoTo 0
If LastCell Is Nothing Then
MsgBox "You pressed Cancel!" & IIf(Tried, "AGAIN! Good-Bye!", "!")
If Tried2 Then Exit Sub
Tried2 = True
GoTo GetCell2
Else
MsgBox LastCell.Address
End If
Loop Until LastCell.Count = 1
Lastrow = LastCell.Row
Firstrow = Int(Firstrow)
Lastrow = Int(Lastrow)
MsgBox Firstrow & " - " & Lastrow
Rangecount = Lastrow - Firstrow
MsgBox Rangecount & " records exported"
Range(Firstrow & ":" & Lastrow).Select
For I = Firstrow To Lastrow
If IsEmpty(Cells(I, "C").Value) Then
Dim G As Variant
Dim H As Variant
'Select Case IsEmpty(Cells(I, "G").Value) Or IsNull(Cells(I,
"G").Value) 'Cells(I, "G").Value = " "
If IsEmpty(Cells(I, "N").Value) Or Cells(I, "N").Value = "" Then
NVariable = ""
Else: NVariable = Cells(I, "N").Value
End If
If IsEmpty(Cells(I, "M").Value) Or Cells(I, "M").Value = "" Then
MVariable = ""
Else: MVariable = Cells(I, "M").Value
End If
NandMVariable = NVariable + MVariable
If IsEmpty(NandMVariable) Or NandMVariable = "" Then
NANDMVARSTRING = ""
ElseIf (IsEmpty(NVariable) And NVariable = "" And Not
IsEmpty(MVariable)) Then
NANDMVARSTRING = "$DATUM " & MVariable & vbCrLf
ElseIf (IsEmpty(MVariable) And MVariable = "" And Not
IsEmpty(NVariable)) Then
NANDMVARSTRING = "$DATUM " & NVariable & vbCrLf
ElseIf Not IsEmpty(NandMVariable) Then
NANDMVARSTRING = "$DATUM " & NVariable & "_" & MVariable &
vbCrLf
End If
If IsEmpty(Cells(I, "A").Value) Or Cells(I, "A").Value = "" Then
AVariable = ""
Else: AVariable = Cells(I, "A").Value
End If
If IsEmpty(AVariable) Or AVariable = "" Then
AVARSTRING = ""
Else
AVARSTRING = "$DATUM siRNA for Gene target: " & AVariable & vbCrLf
End If
If IsEmpty(Cells(I, "F").Value) Or Cells(I, "F").Value = "" Then
FVariable = ""
Else: FVariable = Cells(I, "F").Value
End If
If IsEmpty(FVariable) Or FVariable = "" Then
FVARSTRING = ""
Else
FVARSTRING = "GeneIndex Id: " & FVariable & vbCrLf
End If
If IsEmpty(Cells(I, "E").Value) Or Cells(I, "E").Value = "" Then
EVariable = ""
Else: EVariable = Cells(I, "E").Value
End If
If IsEmpty(EVariable) Or EVariable = "" Then
EVARSTRING = ""
Else: EVARSTRING = "Accession number: " & EVariable & vbCrLf
End If
Print #1, vbCrLf; " -ISIS- 10310514382D" & vbCrLf & vbCrLf _
; " 0 0 0 0 0 0 0 0 0 0999 v2000" & vbCrLf _
; "M END" & vbCrLf _
; "$DTYPE BATCH:LAB_JOURNAL" & vbCrLf _
; NANDMVARSTRING _
; "$DTYPE BATCH:LIN_STRUCT_CODE" & vbCrLf _
; "$DATUM N" & vbCrLf _
; "$DTYPE BATCH:LIN_STRUCT_DESC" & vbCrLf _
; "$DATUM Pool components: Pool1-1; Pool1-2; Pool1-3" &
vbCrLf _
; "$DTYPE BATCHRODUCER(1)RODUCER" & vbCrLf _
; "$DATUM " & Cells(I, "R").Value & ";", vbCrLf _
; "$DTYPE BATCHREP_DESCR" & vbCrLf _
; AVARSTRING _
; FVARSTRING _
; EVARSTRING _
; "$DTYPE BATCH:GENERIC_NAME(1):GENERIC_NAME" & vbCrLf _
; "$DATUM " & Cells(I, "B").Value & vbCrLf _
; "$RIREG " & I - 2 & vbCrLf _
; "$DTYPE BATCH:CHEMIST" & vbCrLf _
; "$DATUM REIDHAAJ" & vbCrLf _
; "$DTYPE BATCH:STRUCT_CMNT" & vbCrLf _
; "$DATUM [NUCLEIC ACID]" & vbCrLf _
; "$DTYPE STRUCTURE" & vbCrLf _
; "$DATUM $MFMT"
Else
'Select Case IsEmpty(Cells(I, "H").Value) Or IsNull(Cells(I,
"H").Value) 'Cells(I, "H").Value = " "
If IsEmpty(Cells(I, "N").Value) Or Cells(I, "N") = "" Then
NVariable = ""
Else: NVariable = Cells(I, "N").Value
End If
If IsEmpty(Cells(I, "M").Value) Or Cells(I, "N") = "" Then
MVariable = ""
Else: MVariable = Cells(I, "M").Value
End If
NandMVariable = NVariable + MVariable
If IsEmpty(NandMVariable) Or NandMVariable = "" Then
NANDMVARSTRING = ""
ElseIf (IsEmpty(NVariable) And NVariable = "" And Not
IsEmpty(MVariable)) Then
NANDMVARSTRING = "$DATUM " & MVariable & vbCrLf
ElseIf (IsEmpty(MVariable) And MVariable = "" And Not
IsEmpty(NVariable)) Then
NANDMVARSTRING = "$DATUM " & NVariable & vbCrLf
ElseIf Not IsEmpty(NandMVariable) Then
NANDMVARSTRING = "$DATUM " & NVariable & "_" & MVariable &
vbCrLf
End If
If IsEmpty(Cells(I, "A").Value) Or Cells(I, "A").Value = ""
Then
AVariable = ""
Else: AVariable = Cells(I, "A").Value
End If
If IsEmpty(AVariable) Then
Else
AVARSTRING = "$DATUM siRNA for Gene target: " & AVariable & vbCrLf
End If
If IsEmpty(Cells(I, "F").Value) Or Cells(I, "F").Value = "" Then
FVariable = ""
Else: FVariable = Cells(I, "F").Value
End If
If IsEmpty(FVariable) Or FVariable = "" Then
FVARSTRING = ""
Else
FVARSTRING = "GeneIndex Id: " & FVariable & vbCrLf
End If
If IsEmpty(Cells(I, "E").Value) Or Cells(I, "E").Value = "" Then
EVariable = ""
Else: EVariable = Cells(I, "E").Value
End If
If IsEmpty(EVariable) Or EVariable = "" Then
EVARSTRING = ""
Else: EVARSTRING = "Accession number: " & EVariable & vbCrLf
End If
Print #1, vbCrLf; " -ISIS- 10310514382D" & vbCrLf & vbCrLf _
; " 0 0 0 0 0 0 0 0 0 0999 v2000" & vbCrLf _
; "M END" & vbCrLf _
; "$DTYPE BATCH:LAB_JOURNAL" & vbCrLf _
; NANDMVARSTRING _
; "$DTYPE BATCH:LIN_STRUCT_CODE" & vbCrLf _
; "$DATUM N" & vbCrLf _
; "$DTYPE BATCH:LIN_STRUCT_DESC" & vbCrLf _
; "$DATUM Sense Strand: " & Cells(I, "C").Value; ";" & "
Antisense Strand:" & vbCrLf _
; Cells(I, "D").Value & vbCrLf _
; "$DTYPE BATCHRODUCER(1)RODUCER" & vbCrLf _
; "$DATUM " & Cells(I, "R").Value & vbCrLf _
; "$DTYPE BATCHREP_DESCR" & vbCrLf _
; AVARSTRING _
; FVARSTRING _
; EVARSTRING _
; "$DTYPE BATCH:GENERIC_NAME(1):GENERIC_NAME" & vbCrLf _
; "$DATUM " & Cells(I, "B").Value & vbCrLf _
; "$RIREG " & I - 2 & vbCrLf _
; "$DTYPE BATCH:CHEMIST" & vbCrLf _
; "$DATUM REIDHAAJ" & vbCrLf _
; "$DTYPE BATCH:STRUCT_CMNT" & vbCrLf _
; "$DATUM [NUCLEIC ACID]" & vbCrLf _
; "$DTYPE STRUCTURE" & vbCrLf _
; "$DATUM $MFMT"
End If
Next I
Close #1
End Sub
Sub FormatData()
Dim wksCurrent As Worksheet
Dim wksNew As Worksheet
Dim rngHeadings As Range
Dim rngCurrent As Range
Set wksCurrent = ActiveSheet 'Could be any sheet you want
Set wksNew = Worksheets.Add
With wksCurrent 'Assume headings are in row 1
Set rngHeadings = .Range(.Range("A1"), .Cells(1,
Columns.Count).End(xlToLeft))
End With
For Each rngCurrent In rngHeadings
Select Case rngCurrent.Value
Case "Gene target" 'Heading This Goes to A
rngCurrent.EntireColumn.Copy wksNew.Columns("A")
Case "siRNA name" 'Heading That Goes to B
rngCurrent.EntireColumn.Copy wksNew.Columns("B")
Case "Sense strand (5' -> 3')" 'Heading The Other Goes to C
rngCurrent.EntireColumn.Copy wksNew.Columns("C")
Case "Antisense strand (5' -> 3')" 'Heading that goes to column D
rngCurrent.EntireColumn.Copy wksNew.Columns("D")
Case "Accession number" 'Heading that goes to column E
rngCurrent.EntireColumn.Copy wksNew.Columns("E")
Case "GeneIndex ID" 'Heading that goes to column F
rngCurrent.EntireColumn.Copy wksNew.Columns("F")
Case "Position in sequence" 'Heading that goes to column G
rngCurrent.EntireColumn.Copy wksNew.Columns("G")
Case "CDS" 'Heading that goes to column H
rngCurrent.EntireColumn.Copy wksNew.Columns("H")
Case "Distance relative to AUG" 'Heading that goes to column I
rngCurrent.EntireColumn.Copy wksNew.Columns("I")
Case "Number of G/C in duplex region" 'Heading that goes to
column J
rngCurrent.EntireColumn.Copy wksNew.Columns("J")
Case "Modification" 'Heading that goes to column K
rngCurrent.EntireColumn.Copy wksNew.Columns("K")
Case "Order designation" 'Heading that goes to column L
rngCurrent.EntireColumn.Copy wksNew.Columns("L")
Case "Date ordered" 'Heading that goes to column M
rngCurrent.EntireColumn.Copy wksNew.Columns("M")
Case "Synthesis designation" 'Heading that goes to column N
rngCurrent.EntireColumn.Copy wksNew.Columns("N")
Case "Separate strands or duplex" 'Heading that goes to column O
rngCurrent.EntireColumn.Copy wksNew.Columns("O")
Case "Bottom strand overhang matches sense strand sequence"
'Heading that goes to column P
rngCurrent.EntireColumn.Copy wksNew.Columns("P")
Case "Top strand overhang matches antisense strand sequence" '
Heading that goes to column Q
rngCurrent.EntireColumn.Copy wksNew.Columns("Q")
Case "Synthesized by" 'Heading that goes to column R
rngCurrent.EntireColumn.Copy wksNew.Columns("R")
Case "Pool components" 'Heading that goes to column S
rngCurrent.EntireColumn.Copy wksNew.Columns("S")
Case "Freezer box" 'Heading that goes to column T
rngCurrent.EntireColumn.Copy wksNew.Columns("T")
Case "Comments" 'Heading that goes to column U
rngCurrent.EntireColumn.Copy wksNew.Columns("U")
End Select
Next rngCurrent
End Sub
exports it into a txt file. My problem is it displays the information coming
from the N and M fields, but if there is nothing in the N field, it doesn't
display the information from the M field either. What I need is if there is
any information coming from either one, it should show up in the exported
text file? Why is information not being displayed if one of the fields is
missing in the export? Below is the code.
Sub GetRows()
Dim FirstCell As Range, LastCell As Range
On Error Resume Next
Dim Firstrow As Long, Lastrow As Long
Dim Wordstring As String
Dim filePath As String
Dim I As Integer
Dim FName As Variant
Dim Rangecount As Integer
Dim intresult As Long
Dim NVariable As String
Dim MVariable As String
Dim AVariable As String
Dim AVARSTRING As String
Dim FVariable As String
Dim FVARSTRING As String
Dim EVariable As String
Dim EVARSTRING As String
Dim NandMVariable As String
Dim NANDMVARSTRING As String
Kill (filePath = ActiveWorkbook.Path & "\Seqfile.rdf")
Worksheets.Select
Call FormatData
I = 0
Tried = False
Tried2 = False
Wordstring = "$RDFILE 1" & vbCrLf & _
"$DATM " & Date & " " & Time & vbCrLf & _
"$RIREG 1" & vbCrLf & _
"$DTYPE BATCH:CHEMIST" & vbCrLf & _
"$DATUM REIDHAAJ" & vbCrLf & _
"$DTYPE BATCH:STRUCT_CMNT" & vbCrLf & _
"$DATUM [NUCLEIC ACID]" & vbCrLf & _
"$DTYPE STRUCTURE" & vbCrLf & _
"$DATUM $MFMT"
filePath = ActiveWorkbook.Path & "\Seqfile.rdf"
Open filePath For Output As #1
Print #1, Wordstring
Do
GetCell:
On Error Resume Next
Set FirstCell = Application.InputBox("Enter top left data cell - ONE
cell only ", Type:=8)
On Error GoTo 0
If FirstCell Is Nothing Then
MsgBox "You pressed Cancel!" & IIf(Tried, "AGAIN! Good-bye!", "!")
If Tried Then Exit Sub
Tried = True
GoTo GetCell
Else
MsgBox FirstCell.Address
End If
Loop Until FirstCell.Count = 1
Firstrow = FirstCell.Row
Do
GetCell2:
On Error Resume Next
Set LastCell = Application.InputBox("Enter bottom right data cell - ONE
cellonly ", Type:=8)
On Error GoTo 0
If LastCell Is Nothing Then
MsgBox "You pressed Cancel!" & IIf(Tried, "AGAIN! Good-Bye!", "!")
If Tried2 Then Exit Sub
Tried2 = True
GoTo GetCell2
Else
MsgBox LastCell.Address
End If
Loop Until LastCell.Count = 1
Lastrow = LastCell.Row
Firstrow = Int(Firstrow)
Lastrow = Int(Lastrow)
MsgBox Firstrow & " - " & Lastrow
Rangecount = Lastrow - Firstrow
MsgBox Rangecount & " records exported"
Range(Firstrow & ":" & Lastrow).Select
For I = Firstrow To Lastrow
If IsEmpty(Cells(I, "C").Value) Then
Dim G As Variant
Dim H As Variant
'Select Case IsEmpty(Cells(I, "G").Value) Or IsNull(Cells(I,
"G").Value) 'Cells(I, "G").Value = " "
If IsEmpty(Cells(I, "N").Value) Or Cells(I, "N").Value = "" Then
NVariable = ""
Else: NVariable = Cells(I, "N").Value
End If
If IsEmpty(Cells(I, "M").Value) Or Cells(I, "M").Value = "" Then
MVariable = ""
Else: MVariable = Cells(I, "M").Value
End If
NandMVariable = NVariable + MVariable
If IsEmpty(NandMVariable) Or NandMVariable = "" Then
NANDMVARSTRING = ""
ElseIf (IsEmpty(NVariable) And NVariable = "" And Not
IsEmpty(MVariable)) Then
NANDMVARSTRING = "$DATUM " & MVariable & vbCrLf
ElseIf (IsEmpty(MVariable) And MVariable = "" And Not
IsEmpty(NVariable)) Then
NANDMVARSTRING = "$DATUM " & NVariable & vbCrLf
ElseIf Not IsEmpty(NandMVariable) Then
NANDMVARSTRING = "$DATUM " & NVariable & "_" & MVariable &
vbCrLf
End If
If IsEmpty(Cells(I, "A").Value) Or Cells(I, "A").Value = "" Then
AVariable = ""
Else: AVariable = Cells(I, "A").Value
End If
If IsEmpty(AVariable) Or AVariable = "" Then
AVARSTRING = ""
Else
AVARSTRING = "$DATUM siRNA for Gene target: " & AVariable & vbCrLf
End If
If IsEmpty(Cells(I, "F").Value) Or Cells(I, "F").Value = "" Then
FVariable = ""
Else: FVariable = Cells(I, "F").Value
End If
If IsEmpty(FVariable) Or FVariable = "" Then
FVARSTRING = ""
Else
FVARSTRING = "GeneIndex Id: " & FVariable & vbCrLf
End If
If IsEmpty(Cells(I, "E").Value) Or Cells(I, "E").Value = "" Then
EVariable = ""
Else: EVariable = Cells(I, "E").Value
End If
If IsEmpty(EVariable) Or EVariable = "" Then
EVARSTRING = ""
Else: EVARSTRING = "Accession number: " & EVariable & vbCrLf
End If
Print #1, vbCrLf; " -ISIS- 10310514382D" & vbCrLf & vbCrLf _
; " 0 0 0 0 0 0 0 0 0 0999 v2000" & vbCrLf _
; "M END" & vbCrLf _
; "$DTYPE BATCH:LAB_JOURNAL" & vbCrLf _
; NANDMVARSTRING _
; "$DTYPE BATCH:LIN_STRUCT_CODE" & vbCrLf _
; "$DATUM N" & vbCrLf _
; "$DTYPE BATCH:LIN_STRUCT_DESC" & vbCrLf _
; "$DATUM Pool components: Pool1-1; Pool1-2; Pool1-3" &
vbCrLf _
; "$DTYPE BATCHRODUCER(1)RODUCER" & vbCrLf _
; "$DATUM " & Cells(I, "R").Value & ";", vbCrLf _
; "$DTYPE BATCHREP_DESCR" & vbCrLf _
; AVARSTRING _
; FVARSTRING _
; EVARSTRING _
; "$DTYPE BATCH:GENERIC_NAME(1):GENERIC_NAME" & vbCrLf _
; "$DATUM " & Cells(I, "B").Value & vbCrLf _
; "$RIREG " & I - 2 & vbCrLf _
; "$DTYPE BATCH:CHEMIST" & vbCrLf _
; "$DATUM REIDHAAJ" & vbCrLf _
; "$DTYPE BATCH:STRUCT_CMNT" & vbCrLf _
; "$DATUM [NUCLEIC ACID]" & vbCrLf _
; "$DTYPE STRUCTURE" & vbCrLf _
; "$DATUM $MFMT"
Else
'Select Case IsEmpty(Cells(I, "H").Value) Or IsNull(Cells(I,
"H").Value) 'Cells(I, "H").Value = " "
If IsEmpty(Cells(I, "N").Value) Or Cells(I, "N") = "" Then
NVariable = ""
Else: NVariable = Cells(I, "N").Value
End If
If IsEmpty(Cells(I, "M").Value) Or Cells(I, "N") = "" Then
MVariable = ""
Else: MVariable = Cells(I, "M").Value
End If
NandMVariable = NVariable + MVariable
If IsEmpty(NandMVariable) Or NandMVariable = "" Then
NANDMVARSTRING = ""
ElseIf (IsEmpty(NVariable) And NVariable = "" And Not
IsEmpty(MVariable)) Then
NANDMVARSTRING = "$DATUM " & MVariable & vbCrLf
ElseIf (IsEmpty(MVariable) And MVariable = "" And Not
IsEmpty(NVariable)) Then
NANDMVARSTRING = "$DATUM " & NVariable & vbCrLf
ElseIf Not IsEmpty(NandMVariable) Then
NANDMVARSTRING = "$DATUM " & NVariable & "_" & MVariable &
vbCrLf
End If
If IsEmpty(Cells(I, "A").Value) Or Cells(I, "A").Value = ""
Then
AVariable = ""
Else: AVariable = Cells(I, "A").Value
End If
If IsEmpty(AVariable) Then
Else
AVARSTRING = "$DATUM siRNA for Gene target: " & AVariable & vbCrLf
End If
If IsEmpty(Cells(I, "F").Value) Or Cells(I, "F").Value = "" Then
FVariable = ""
Else: FVariable = Cells(I, "F").Value
End If
If IsEmpty(FVariable) Or FVariable = "" Then
FVARSTRING = ""
Else
FVARSTRING = "GeneIndex Id: " & FVariable & vbCrLf
End If
If IsEmpty(Cells(I, "E").Value) Or Cells(I, "E").Value = "" Then
EVariable = ""
Else: EVariable = Cells(I, "E").Value
End If
If IsEmpty(EVariable) Or EVariable = "" Then
EVARSTRING = ""
Else: EVARSTRING = "Accession number: " & EVariable & vbCrLf
End If
Print #1, vbCrLf; " -ISIS- 10310514382D" & vbCrLf & vbCrLf _
; " 0 0 0 0 0 0 0 0 0 0999 v2000" & vbCrLf _
; "M END" & vbCrLf _
; "$DTYPE BATCH:LAB_JOURNAL" & vbCrLf _
; NANDMVARSTRING _
; "$DTYPE BATCH:LIN_STRUCT_CODE" & vbCrLf _
; "$DATUM N" & vbCrLf _
; "$DTYPE BATCH:LIN_STRUCT_DESC" & vbCrLf _
; "$DATUM Sense Strand: " & Cells(I, "C").Value; ";" & "
Antisense Strand:" & vbCrLf _
; Cells(I, "D").Value & vbCrLf _
; "$DTYPE BATCHRODUCER(1)RODUCER" & vbCrLf _
; "$DATUM " & Cells(I, "R").Value & vbCrLf _
; "$DTYPE BATCHREP_DESCR" & vbCrLf _
; AVARSTRING _
; FVARSTRING _
; EVARSTRING _
; "$DTYPE BATCH:GENERIC_NAME(1):GENERIC_NAME" & vbCrLf _
; "$DATUM " & Cells(I, "B").Value & vbCrLf _
; "$RIREG " & I - 2 & vbCrLf _
; "$DTYPE BATCH:CHEMIST" & vbCrLf _
; "$DATUM REIDHAAJ" & vbCrLf _
; "$DTYPE BATCH:STRUCT_CMNT" & vbCrLf _
; "$DATUM [NUCLEIC ACID]" & vbCrLf _
; "$DTYPE STRUCTURE" & vbCrLf _
; "$DATUM $MFMT"
End If
Next I
Close #1
End Sub
Sub FormatData()
Dim wksCurrent As Worksheet
Dim wksNew As Worksheet
Dim rngHeadings As Range
Dim rngCurrent As Range
Set wksCurrent = ActiveSheet 'Could be any sheet you want
Set wksNew = Worksheets.Add
With wksCurrent 'Assume headings are in row 1
Set rngHeadings = .Range(.Range("A1"), .Cells(1,
Columns.Count).End(xlToLeft))
End With
For Each rngCurrent In rngHeadings
Select Case rngCurrent.Value
Case "Gene target" 'Heading This Goes to A
rngCurrent.EntireColumn.Copy wksNew.Columns("A")
Case "siRNA name" 'Heading That Goes to B
rngCurrent.EntireColumn.Copy wksNew.Columns("B")
Case "Sense strand (5' -> 3')" 'Heading The Other Goes to C
rngCurrent.EntireColumn.Copy wksNew.Columns("C")
Case "Antisense strand (5' -> 3')" 'Heading that goes to column D
rngCurrent.EntireColumn.Copy wksNew.Columns("D")
Case "Accession number" 'Heading that goes to column E
rngCurrent.EntireColumn.Copy wksNew.Columns("E")
Case "GeneIndex ID" 'Heading that goes to column F
rngCurrent.EntireColumn.Copy wksNew.Columns("F")
Case "Position in sequence" 'Heading that goes to column G
rngCurrent.EntireColumn.Copy wksNew.Columns("G")
Case "CDS" 'Heading that goes to column H
rngCurrent.EntireColumn.Copy wksNew.Columns("H")
Case "Distance relative to AUG" 'Heading that goes to column I
rngCurrent.EntireColumn.Copy wksNew.Columns("I")
Case "Number of G/C in duplex region" 'Heading that goes to
column J
rngCurrent.EntireColumn.Copy wksNew.Columns("J")
Case "Modification" 'Heading that goes to column K
rngCurrent.EntireColumn.Copy wksNew.Columns("K")
Case "Order designation" 'Heading that goes to column L
rngCurrent.EntireColumn.Copy wksNew.Columns("L")
Case "Date ordered" 'Heading that goes to column M
rngCurrent.EntireColumn.Copy wksNew.Columns("M")
Case "Synthesis designation" 'Heading that goes to column N
rngCurrent.EntireColumn.Copy wksNew.Columns("N")
Case "Separate strands or duplex" 'Heading that goes to column O
rngCurrent.EntireColumn.Copy wksNew.Columns("O")
Case "Bottom strand overhang matches sense strand sequence"
'Heading that goes to column P
rngCurrent.EntireColumn.Copy wksNew.Columns("P")
Case "Top strand overhang matches antisense strand sequence" '
Heading that goes to column Q
rngCurrent.EntireColumn.Copy wksNew.Columns("Q")
Case "Synthesized by" 'Heading that goes to column R
rngCurrent.EntireColumn.Copy wksNew.Columns("R")
Case "Pool components" 'Heading that goes to column S
rngCurrent.EntireColumn.Copy wksNew.Columns("S")
Case "Freezer box" 'Heading that goes to column T
rngCurrent.EntireColumn.Copy wksNew.Columns("T")
Case "Comments" 'Heading that goes to column U
rngCurrent.EntireColumn.Copy wksNew.Columns("U")
End Select
Next rngCurrent
End Sub