Compile Error: END IF Without Block IF (Persistent Error) [closed] - excel

Closed. This question needs details or clarity. It is not currently accepting answers.
Want to improve this question? Add details and clarify the problem by editing this post.
Closed 7 years ago.
Improve this question
I really need help with this project that I am working on but I cannot seem to get this error off my back. Could anyone please recommend solutions ?
Sub Dsurvey()
Dim i As Integer
Dim j As Integer
Dim k As Integer
k = 3
For i = 3 To 22
j = j + 1
If Sheets("2").Cells(j, "A").Value - Sheets("2").Cells(i, "A").Value = Sheets("2").Cells(j, "B").Value - Sheets("2").Cells(i, "B").Value Then
Sheets("2").Cells(k, "J").Value = Sheets("2").Cells(i, "A").Value
Sheets("2").Cells(k, "K").Value = Sheets("2").Cells(i, "B").Value
Do While Sheets("2").Cells(k, "J").Value <= Sheets("2").Cells(j, "A").Value
Sheets("2").Cells(k, "J").Value = Sheets("2").Cells(k - 1, "J").Value + 100
Sheets("2").Cells(k, "K").Value = Sheets("2").Cells(k - 1, "K").Value + 100
k = k + 1
End If
Next i
End Sub


It isn't so much that you are missing an End If , but you are not closing the Do While with a Loop.
k = 3
For i = 3 To 22
j = j + 1
If Sheets("2").Cells(j, "A").Value - Sheets("2").Cells(i, "A").Value = Sheets("2").Cells(j, "B").Value - Sheets("2").Cells(i, "B").Value Then
Sheets("2").Cells(k, "J").Value = Sheets("2").Cells(i, "A").Value
Sheets("2").Cells(k, "K").Value = Sheets("2").Cells(i, "B").Value
Do While Sheets("2").Cells(k, "J").Value <= Sheets("2").Cells(j, "A").Value
Sheets("2").Cells(k, "J").Value = Sheets("2").Cells(k - 1, "J").Value + 100
Sheets("2").Cells(k, "K").Value = Sheets("2").Cells(k - 1, "K").Value + 100
k = k + 1
Loop
End If
Next i
Debug version:
k = 3
With Sheets("2")
For i = 3 To 22
j = j + 1
If IsNumeric(.Cells(j, "A")) And IsNumeric(.Cells(i, "A")) And IsNumeric(.Cells(j, "B")) And IsNumeric(.Cells(i, "B")) Then
If .Cells(j, "A").Value - .Cells(i, "A").Value = .Cells(j, "B").Value - .Cells(i, "B").Value Then
.Cells(k, "J").Value = .Cells(i, "A").Value
.Cells(k, "K").Value = .Cells(i, "B").Value
Do While .Cells(k, "J").Value <= .Cells(j, "A").Value
.Cells(k, "J").Value = .Cells(k - 1, "J").Value + 100
.Cells(k, "K").Value = .Cells(k - 1, "K").Value + 100
k = k + 1
Loop
End If
Else
Debug.Print "Not numeric: & " & i & Chr(45) & j & Chr(45) & k
End If
Next i
End With

Related

How to sum and remove duplicates on 2 columns

Application Match for one column works but for 2 columns is giving me error
With Sht
LastRow = .Cells(.Rows.Count, "J").End(xlUp).Row
For i = LastRow To 2 Step -1
DupRow = Application.Match(Cells(i, 9).Value, Range(Cells(1, 9), Cells(i - 1, 9)), 0)
DoEvents
If Not IsError(DupRow) Then
Cells(i, 8).Value = Cells(i, 8).Value + Cells(DupRow, 8).Value
Cells(i, 9).Value = Cells(i, 9).Value + Cells(DupRow, 9).Value
Rows(DupRow).Delete
End If
Next i
End With
for 2 columns Error runtime 1004
DupRow = Application.Match(Cells(i, 4).Value & Cells(i, 5).Value, Range(Cells(1, 4) & Cells(1, 5), Cells(i - 1, 4) & Cells(i - 1, 5)), 0)
What is the correct way of doing this?

In my opinion it's better to use dictionary for that, which has built-in method for managing keys, so it can be used to get unique values:
Sub teest()
Dim val As String
Set dict = CreateObject("Scripting.Dictionary")
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
For i = LastRow To 2 Step -1
val = Cells(i, 1).Value & Cells(i, 2).Value
If dict.Exists(val) Then
Rows(i).Delete
Else
dict.Add val, 0
End If
Next
End Sub

Add new line into the Excel Table if Condition meet

I have a Excel Table in which I'd like to add new line if condition meet. Actually my code is working partly. It adds lines but when the work finish Debug appears (Run-time error 13, type mismatch).
I am in trouble if sometimes unexpected error happens. So please help me make my code more advance and work properly.
Sub AddWorkingYearLine2()
Dim i As Long
With Worksheets("DB")
For i = Cells(Rows.Count, "A").End(xlUp).Row To 4 Step -1
'make sure it's not an "old entry"
If Cells(i, "A").Value2 <> Cells(i + 1, "A").Value2 Then
'if today occurs after "end date" then
If Range("D1") > CDate(Cells(i, "F").Value) And Len(Cells(i, "F").Value2) > 0 Then
'insert row
Rows(i + 1).Insert Shift:=xlShiftDown
'copy row down
'Rows(i + 1).Value = Rows(i).Value
'update dates
Cells(i + 1, "A").Value = Cells(i, "A").Value
Cells(i + 1, "B").Value = Cells(i, "B").Value
Cells(i + 1, "C").Value = Cells(i, "C").Value
Cells(i + 1, "D").Value = Cells(i, "D").Value
Cells(i + 1, "E").Value = Cells(i, "F").Value
Cells(i + 1, "F").Value = DateAdd("yyyy", 1, CDate(Cells(i + 1, "E").Value))
Cells(i + 1, "G").Value = Cells(i, "M").Value
Cells(i + 1, "H").Value = Cells(i, "H").Value
Cells(i + 1, "I").Value = Cells(i, "I").Value
Cells(i + 1, "J").Value = Cells(i, "J").Value
Application.CutCopyMode = False
End If
End If
Next i
End With
End Sub

you're using With Worksheets("DB") but then you're not referencing all range objects to Worksheets("DB") object since you're not using dots...
Dim i As Long
With Worksheets("DB")
For i = .Cells(.Rows.Count, "A").End(xlUp).Row To 4 Step -1
'make sure it's not an "old entry"
If .Cells(i, "A").Value2 <> .Cells(i + 1, "A").Value2 Then
'if today occurs after "end date" then
If .Range("D1") > CDate(.Cells(i, "F").Value) And Len(.Cells(i, "F").Value2) > 0 Then
'insert row
.Rows(i + 1).Insert Shift:=xlShiftDown
'copy row down
'Rows(i + 1).Value = Rows(i).Value
'update dates
.Cells(i + 1, "A").Value = .Cells(i, "A").Value
.Cells(i + 1, "B").Value = .Cells(i, "B").Value
.Cells(i + 1, "C").Value = .Cells(i, "C").Value
.Cells(i + 1, "D").Value = .Cells(i, "D").Value
.Cells(i + 1, "E").Value = .Cells(i, "F").Value
.Cells(i + 1, "F").Value = DateAdd("yyyy", 1, CDate(.Cells(i + 1, "E").Value))
.Cells(i + 1, "G").Value = .Cells(i, "M").Value
.Cells(i + 1, "H").Value = .Cells(i, "H").Value
.Cells(i + 1, "I").Value = .Cells(i, "I").Value
.Cells(i + 1, "J").Value = .Cells(i, "J").Value
Application.CutCopyMode = False
End If
End If
Next
End With

Loop has a do but program says it doesn't

I have a simple yet infuriating question about a piece of code I am writing. For whatever reason, it insists I do no have a Do for my loop despite the do clearly being at the top. Perhaps I've done something while writing my If statements but I do not believe so. If you could look at it and help me out that would be great. Most of the code is a bunch of If, Then, GoTo statement so feel free to skim it.
Do While Cells(i, "B").Value <> ""
'X Block
If Cells(i, "B").Value = "U" Then
GoTo U1:
ElseIf Cells(i, "B").Value = "C" Then
GoTo C1:
ElseIf Cells(i, "B").Value = "A" Then
GoTo A1:
ElseIf Cells(i, "B").Value = "G" Then
GoTo G1:
End If
'UX Block
U1: If Cells(i + 1, "B").Value = "U" Then
GoTo UU2:
ElseIf Cells(i + 1, "B").Value = "C" Then
GoTo UC2:
ElseIf Cells(i + 1, "B").Value = "A" Then
GoTo UA2:
ElseIf Cells(i + 1, "B").Value = "G" Then
GoTo UG2:
End If
'UUX Block
UU2: If Cells(i + 2, "B").Value = "U" Or Cells(i + 2, "B").Value = "C" Then
Cells(a, "C").Value = "Phe"
ElseIf Cells(i + 2, "B").Value = "A" Or Cells(i + 2, "B").Value = "G" Then
Cells(a, "C").Value = "Leu"
End If
GoTo EndOfAcids:
'UCX Block
UC2: Cells(a, "C").Value = "Ser"
GoTo EndOfAcids:
'UAX Block
UA2: If Cells(i + 2, "B").Value = "U" Or Cells(i + 2, "B").Value = "C" Then
Cells(a, "C").Value = "Tyr"
ElseIf Cells(i + 2, "B").Value = "A" Or Cells(i + 2, "B").Value = "G" Then
Cells(a, "C").Value = "Stop Codon"
End If
GoTo EndOfAcids:
'UGX Block
UG2: If Cells(i + 2, "B").Value = "U" Or Cells(i + 2, "B").Value = "C" Then
Cells(a, "C").Value = "Cys"
ElseIf Cells(i + 2, "B").Value = "A" Then
Cells(a, "C").Value = "Stop Codon"
ElseIf Cells(i + 2, "B").Value = "G" Then
Cells(a, "C").Value = "Trp"
End If
GoTo EndOfAcids:
'CX Block
C1: If Cells(i + 1, "B").Value = "U" Then
GoTo CU2:
ElseIf Cells(i + 1, "B").Value = "C" Then
GoTo CC2:
ElseIf Cells(i + 1, "B").Value = "A" Then
GoTo CA2:
ElseIf Cells(i + 1, "B").Value = "G" Then
GoTo CG2:
End If
'CUX Block
CU2: Cells(a, "C").Value = "Leu"
GoTo EndOfAcids:
'CCX Block
CC2: Cells(a, "C").Value = "Pro"
GoTo EndOfAcids:
'CAX Block
CA2: If Cells(i + 2, "B").Value = "U" Or Cells(i + 2, "B").Value = "C" Then
Cells(a, "C").Value = "His"
ElseIf Cells(i + 2, "B").Value = "A" Or Cells(i + 2, "B").Value = "G" Then
Cells(a, "C").Value = "Gln"
End If
GoTo EndOfAcids:
'CGX Block
CG2: Cells(a, "C").Value = "Arg"
GoTo EndOfAcids:
'AX Block
A1: If Cells(i + 1, "B").Value = "U" Then
GoTo AU2:
ElseIf Cells(i + 1, "B").Value = "C" Then
GoTo AC2:
ElseIf Cells(i + 1, "B").Value = "A" Then
GoTo AA2:
ElseIf Cells(i + 1, "B").Value = "G" Then
GoTo AG2:
End If
'AUX Block
AU2: If Cells(i + 2, "B").Value = "U" Or Cells(i + 2, "B").Value = "C" Or Cells(i + 2).Value = "A" Then
Cells(a, "C").Value = "Ile"
ElseIf Cells(i + 2, "B").Value = "G" Then
Cells(a, "C").Value = "Met"
End If
GoTo EndOfAcids:
'ACX Block
AC2: Cells(a, "C").Value = "Thr"
GoTo EndOfAcids:
'AAX Block
AA2: If Cells(i + 2, "B").Value = "U" Or Cells(i + 2, "B").Value = "C" Then
Cells(a, "C").Value = "Asn"
ElseIf Cells(i + 2, "B").Value = "A" Or Cells(i + 2, "B").Value = "G" Then
Cells(a, "C").Value = "Lys"
End If
GoTo EndOfAcids:
'AGX Block
AG2: If Cells(i + 2, "B").Value = "U" Or Cells(i + 2, "B").Value = "C" Then
Cells(a, "C").Value = "Ser"
ElseIf Cells(i + 2, "B").Value = "A" Or Cells(i + 2, "B").Value = "G" Then
Cells(a, "C").Value = "Arg"
End If
GoTo EndOfAcids:
'GX Block
G1: If Cells(i + 1, "B").Value = "U" Then
GoTo GU2:
ElseIf Cells(i + 1, "B").Value = "C" Then
GoTo GC2:
ElseIf Cells(i + 1, "B").Value = "A" Then
GoTo GA2:
ElseIf Cells(i + 1, "B").Value = "G" Then
GoTo GG2:
End If
'GUX Block
GU2: Cells(a, "C").Value = "Val"
GoTo EndOfAcids:
'GCX Block
GC2: Cells(a, "C").Value = "Ala"
GoTo EndOfAcids:
'GAX Block
GA2: If Cells(i + 2, "B").Value = "U" Or Cells(i + 2, "B").Value = "C" Then
Cells(a, "C").Value = "Asp"
ElseIf Cells(i + 2, "B").Value = "A" Or Cells(i + 2, "B").Value = "G" Then
Cells(a, "C").Value = "Glu"
GoTo EndOfAcids:
'GGX Block
GG2: Cells(a, "C").Value = "Gly"
GoTo EndOfAcids:
EndOfAcids:
i = i + 3
a = a + 1
Loop
End Sub
So the do is at the top of the code but when I run it the program says there is no do. Not sure why. Any help would be appreciated. There is slightly more code so I will post the entirety below but the problem loop is what is posted above.
Option Explicit
Sub RNATrascription()
Dim i As Long
Dim a As Long
i = 2
a = 2
Do While Cells(i, "A").Value <> ""
If Cells(i, "A").Value = "A" Or Cells(i, "A").Value = "a" Then
Cells(i, "B").Value = "U"
ElseIf Cells(i, "A").Value = "T" Or Cells(i, "A").Value = "t" Then
Cells(i, "B").Value = "A"
ElseIf Cells(i, "A") = "G" Or Cells(i, "A").Value = "g" Then
Cells(i, "B") = "C"
ElseIf Cells(i, "A") = "C" Or Cells(i, "A").Value = "c" Then
Cells(i, "B") = "G"
ElseIf Cells(i, "A") <> "A" Or Cells(i, "A") <> "a" Or Cells(i, "A") <> "T" Or Cells(i, "A") <> "t" Or Cells(i, "A") <> "G" Or Cells(i, "A") <> "g" Or Cells(i, "A") <> "C" Or Cells(i, "A") <> "c" Then
MsgBox "You have mis typed your DNA sequence"
End If
i = i + 1
Loop
Do While Cells(i, "B").Value <> ""
'X Block
If Cells(i, "B").Value = "U" Then
GoTo U1:
ElseIf Cells(i, "B").Value = "C" Then
GoTo C1:
ElseIf Cells(i, "B").Value = "A" Then
GoTo A1:
ElseIf Cells(i, "B").Value = "G" Then
GoTo G1:
End If
'UX Block
U1: If Cells(i + 1, "B").Value = "U" Then
GoTo UU2:
ElseIf Cells(i + 1, "B").Value = "C" Then
GoTo UC2:
ElseIf Cells(i + 1, "B").Value = "A" Then
GoTo UA2:
ElseIf Cells(i + 1, "B").Value = "G" Then
GoTo UG2:
End If
'UUX Block
UU2: If Cells(i + 2, "B").Value = "U" Or Cells(i + 2, "B").Value = "C" Then
Cells(a, "C").Value = "Phe"
ElseIf Cells(i + 2, "B").Value = "A" Or Cells(i + 2, "B").Value = "G" Then
Cells(a, "C").Value = "Leu"
End If
GoTo EndOfAcids:
'UCX Block
UC2: Cells(a, "C").Value = "Ser"
GoTo EndOfAcids:
'UAX Block
UA2: If Cells(i + 2, "B").Value = "U" Or Cells(i + 2, "B").Value = "C" Then
Cells(a, "C").Value = "Tyr"
ElseIf Cells(i + 2, "B").Value = "A" Or Cells(i + 2, "B").Value = "G" Then
Cells(a, "C").Value = "Stop Codon"
End If
GoTo EndOfAcids:
'UGX Block
UG2: If Cells(i + 2, "B").Value = "U" Or Cells(i + 2, "B").Value = "C" Then
Cells(a, "C").Value = "Cys"
ElseIf Cells(i + 2, "B").Value = "A" Then
Cells(a, "C").Value = "Stop Codon"
ElseIf Cells(i + 2, "B").Value = "G" Then
Cells(a, "C").Value = "Trp"
End If
GoTo EndOfAcids:
'CX Block
C1: If Cells(i + 1, "B").Value = "U" Then
GoTo CU2:
ElseIf Cells(i + 1, "B").Value = "C" Then
GoTo CC2:
ElseIf Cells(i + 1, "B").Value = "A" Then
GoTo CA2:
ElseIf Cells(i + 1, "B").Value = "G" Then
GoTo CG2:
End If
'CUX Block
CU2: Cells(a, "C").Value = "Leu"
GoTo EndOfAcids:
'CCX Block
CC2: Cells(a, "C").Value = "Pro"
GoTo EndOfAcids:
'CAX Block
CA2: If Cells(i + 2, "B").Value = "U" Or Cells(i + 2, "B").Value = "C" Then
Cells(a, "C").Value = "His"
ElseIf Cells(i + 2, "B").Value = "A" Or Cells(i + 2, "B").Value = "G" Then
Cells(a, "C").Value = "Gln"
End If
GoTo EndOfAcids:
'CGX Block
CG2: Cells(a, "C").Value = "Arg"
GoTo EndOfAcids:
'AX Block
A1: If Cells(i + 1, "B").Value = "U" Then
GoTo AU2:
ElseIf Cells(i + 1, "B").Value = "C" Then
GoTo AC2:
ElseIf Cells(i + 1, "B").Value = "A" Then
GoTo AA2:
ElseIf Cells(i + 1, "B").Value = "G" Then
GoTo AG2:
End If
'AUX Block
AU2: If Cells(i + 2, "B").Value = "U" Or Cells(i + 2, "B").Value = "C" Or Cells(i + 2).Value = "A" Then
Cells(a, "C").Value = "Ile"
ElseIf Cells(i + 2, "B").Value = "G" Then
Cells(a, "C").Value = "Met"
End If
GoTo EndOfAcids:
'ACX Block
AC2: Cells(a, "C").Value = "Thr"
GoTo EndOfAcids:
'AAX Block
AA2: If Cells(i + 2, "B").Value = "U" Or Cells(i + 2, "B").Value = "C" Then
Cells(a, "C").Value = "Asn"
ElseIf Cells(i + 2, "B").Value = "A" Or Cells(i + 2, "B").Value = "G" Then
Cells(a, "C").Value = "Lys"
End If
GoTo EndOfAcids:
'AGX Block
AG2: If Cells(i + 2, "B").Value = "U" Or Cells(i + 2, "B").Value = "C" Then
Cells(a, "C").Value = "Ser"
ElseIf Cells(i + 2, "B").Value = "A" Or Cells(i + 2, "B").Value = "G" Then
Cells(a, "C").Value = "Arg"
End If
GoTo EndOfAcids:
'GX Block
G1: If Cells(i + 1, "B").Value = "U" Then
GoTo GU2:
ElseIf Cells(i + 1, "B").Value = "C" Then
GoTo GC2:
ElseIf Cells(i + 1, "B").Value = "A" Then
GoTo GA2:
ElseIf Cells(i + 1, "B").Value = "G" Then
GoTo GG2:
End If
'GUX Block
GU2: Cells(a, "C").Value = "Val"
GoTo EndOfAcids:
'GCX Block
GC2: Cells(a, "C").Value = "Ala"
GoTo EndOfAcids:
'GAX Block
GA2: If Cells(i + 2, "B").Value = "U" Or Cells(i + 2, "B").Value = "C" Then
Cells(a, "C").Value = "Asp"
ElseIf Cells(i + 2, "B").Value = "A" Or Cells(i + 2, "B").Value = "G" Then
Cells(a, "C").Value = "Glu"
GoTo EndOfAcids:
'GGX Block
GG2: Cells(a, "C").Value = "Gly"
GoTo EndOfAcids:
EndOfAcids:
i = i + 3
a = a + 1
Loop
End Sub

try this
Option Explicit
Sub RNATrascription()
Dim i As Long
Dim a As Long
Dim dat As String
i = 2
Do While Cells(i, "A").Value <> ""
Select Case LCase(Cells(i, "A").Value)
Case "a": dat = "U"
Case "t": dat = "A"
Case "g": dat = "C"
Case "c": dat = "G"
Case Else
MsgBox "You have mis typed your DNA sequence"
End
End Select
Cells(i, "B") = dat
i = i + 1
Loop
i = 2
a = 2
Dim cc2 As String
Dim cc3 As String
Do While Cells(i, "B").Value <> ""
cc2 = Cells(i, "B") & Cells(i + 1, "B")
cc3 = cc2 & Cells(i + 2, "B")
dat = ""
Select Case cc2
Case "uc": dat = "Ser"
Case "cu": dat = "Leu"
Case "cc": dat = "Pro"
Case "ac": dat = "Thr"
Case "gu": dat = "Val"
Case "gc": dat = "Ala"
End Select
If dat = "" Then
Select Case cc3
Case "uuu", "uuc": dat = "Phe"
Case "uua", "uug": dat = "Ley"
Case "uau", "uac": dat = "Tyr"
Case "uaa", "uag", "uga": dat = "Stop Codon"
Case "ugu", "ugc": dat = "Sys"
Case "ugg": dat = "Trp"
Case "cau": dat = "His"
Case "caa": dat = "Gln"
Case "cgc": dat = "Arg"
Case "auu", "aua": dat = "Ile"
Case "aug": dat = "Met"
Case "aau", "agu", "agc": dat = "Asn"
Case "aaa", "aga", "agg": dat = "Lys"
Case "gau", "gac": dat = "Asp"
Case "gaa", "gag": dat = "Glu"
Case Else: dat = "ERROR"
End Select
End If
Cells(a, "C").Value = dat
i = i + 3
a = a + 1
Loop
End Sub

your code should have been formatted something like this .... if you did that in the first place, you may have noticed that there is no end if in the GAX block
Option Explicit
Sub RNATrascription()
Dim i As Long
Dim a As Long
i = 2
a = 2
Do While Cells(i, "A").Value <> ""
If Cells(i, "A").Value = "A" Or Cells(i, "A").Value = "a" Then
Cells(i, "B").Value = "U"
ElseIf Cells(i, "A").Value = "T" Or Cells(i, "A").Value = "t" Then
Cells(i, "B").Value = "A"
ElseIf Cells(i, "A") = "G" Or Cells(i, "A").Value = "g" Then
Cells(i, "B") = "C"
ElseIf Cells(i, "A") = "C" Or Cells(i, "A").Value = "c" Then
Cells(i, "B") = "G"
ElseIf Cells(i, "A") <> "A" Or Cells(i, "A") <> "a" Or Cells(i, "A") <> "T" Or Cells(i, "A") <> "t" Or Cells(i, "A") <> "G" Or Cells(i, "A") <> "g" Or Cells(i, "A") <> "C" Or Cells(i, "A") <> "c" Then
MsgBox "You have mis typed your DNA sequence"
End If
i = i + 1
Loop
Do While Cells(i, "B").Value <> ""
'X Block
If Cells(i, "B").Value = "U" Then
GoTo U1:
ElseIf Cells(i, "B").Value = "C" Then
GoTo C1:
ElseIf Cells(i, "B").Value = "A" Then
GoTo A1:
ElseIf Cells(i, "B").Value = "G" Then
GoTo G1:
End If
'UX Block
U1:
If Cells(i + 1, "B").Value = "U" Then
GoTo UU2:
ElseIf Cells(i + 1, "B").Value = "C" Then
GoTo UC2:
ElseIf Cells(i + 1, "B").Value = "A" Then
GoTo UA2:
ElseIf Cells(i + 1, "B").Value = "G" Then
GoTo UG2:
End If
'UUX Block
UU2:
If Cells(i + 2, "B").Value = "U" Or Cells(i + 2, "B").Value = "C" Then
Cells(a, "C").Value = "Phe"
ElseIf Cells(i + 2, "B").Value = "A" Or Cells(i + 2, "B").Value = "G" Then
Cells(a, "C").Value = "Leu"
End If
GoTo EndOfAcids:
'UCX Block
UC2:
Cells(a, "C").Value = "Ser"
GoTo EndOfAcids:
'UAX Block
UA2:
If Cells(i + 2, "B").Value = "U" Or Cells(i + 2, "B").Value = "C" Then
Cells(a, "C").Value = "Tyr"
ElseIf Cells(i + 2, "B").Value = "A" Or Cells(i + 2, "B").Value = "G" Then
Cells(a, "C").Value = "Stop Codon"
End If
GoTo EndOfAcids:
'UGX Block
UG2:
If Cells(i + 2, "B").Value = "U" Or Cells(i + 2, "B").Value = "C" Then
Cells(a, "C").Value = "Cys"
ElseIf Cells(i + 2, "B").Value = "A" Then
Cells(a, "C").Value = "Stop Codon"
ElseIf Cells(i + 2, "B").Value = "G" Then
Cells(a, "C").Value = "Trp"
End If
GoTo EndOfAcids:
'CX Block
C1:
If Cells(i + 1, "B").Value = "U" Then
GoTo CU2:
ElseIf Cells(i + 1, "B").Value = "C" Then
GoTo CC2:
ElseIf Cells(i + 1, "B").Value = "A" Then
GoTo CA2:
ElseIf Cells(i + 1, "B").Value = "G" Then
GoTo CG2:
End If
'CUX Block
CU2:
Cells(a, "C").Value = "Leu"
GoTo EndOfAcids:
'CCX Block
CC2:
Cells(a, "C").Value = "Pro"
GoTo EndOfAcids:
'CAX Block
CA2:
If Cells(i + 2, "B").Value = "U" Or Cells(i + 2, "B").Value = "C" Then
Cells(a, "C").Value = "His"
ElseIf Cells(i + 2, "B").Value = "A" Or Cells(i + 2, "B").Value = "G" Then
Cells(a, "C").Value = "Gln"
End If
GoTo EndOfAcids:
'CGX Block
CG2:
Cells(a, "C").Value = "Arg"
GoTo EndOfAcids:
'AX Block
A1:
If Cells(i + 1, "B").Value = "U" Then
GoTo AU2:
ElseIf Cells(i + 1, "B").Value = "C" Then
GoTo AC2:
ElseIf Cells(i + 1, "B").Value = "A" Then
GoTo AA2:
ElseIf Cells(i + 1, "B").Value = "G" Then
GoTo AG2:
End If
'AUX Block
AU2:
If Cells(i + 2, "B").Value = "U" Or Cells(i + 2, "B").Value = "C" Or Cells(i + 2).Value = "A" Then
Cells(a, "C").Value = "Ile"
ElseIf Cells(i + 2, "B").Value = "G" Then
Cells(a, "C").Value = "Met"
End If
GoTo EndOfAcids:
'ACX Block
AC2:
Cells(a, "C").Value = "Thr"
GoTo EndOfAcids:
'AAX Block
AA2:
If Cells(i + 2, "B").Value = "U" Or Cells(i + 2, "B").Value = "C" Then
Cells(a, "C").Value = "Asn"
ElseIf Cells(i + 2, "B").Value = "A" Or Cells(i + 2, "B").Value = "G" Then
Cells(a, "C").Value = "Lys"
End If
GoTo EndOfAcids:
'AGX Block
AG2:
If Cells(i + 2, "B").Value = "U" Or Cells(i + 2, "B").Value = "C" Then
Cells(a, "C").Value = "Ser"
ElseIf Cells(i + 2, "B").Value = "A" Or Cells(i + 2, "B").Value = "G" Then
Cells(a, "C").Value = "Arg"
End If
GoTo EndOfAcids:
'GX Block
G1:
If Cells(i + 1, "B").Value = "U" Then
GoTo GU2:
ElseIf Cells(i + 1, "B").Value = "C" Then
GoTo GC2:
ElseIf Cells(i + 1, "B").Value = "A" Then
GoTo GA2:
ElseIf Cells(i + 1, "B").Value = "G" Then
GoTo GG2:
End If
'GUX Block
GU2:
Cells(a, "C").Value = "Val"
GoTo EndOfAcids:
'GCX Block
GC2:
Cells(a, "C").Value = "Ala"
GoTo EndOfAcids:
'GAX Block
GA2:
If Cells(i + 2, "B").Value = "U" Or Cells(i + 2, "B").Value = "C" Then
Cells(a, "C").Value = "Asp"
ElseIf Cells(i + 2, "B").Value = "A" Or Cells(i + 2, "B").Value = "G" Then
Cells(a, "C").Value = "Glu"
GoTo EndOfAcids:
'GGX Block
GG2:
Cells(a, "C").Value = "Gly"
GoTo EndOfAcids:
EndOfAcids:
i = i + 3
a = a + 1
Loop
End Sub

Excel based tracking database

I have a code which Sheet "RAW" is updated each day with more rows and updates the existing rows, I'm trying to get the number in Column B to match Column A in sheet data, then depending on what information is in other columns add 1 to a value in a column (17 different options)
It's basically going to be used as a tracker to check how many days something is on a specific status and I need to keep it for historical Measuring indefintely. here is what I have so far which doesn't seem to work.
Additionally I would also like it to measure an 18th catagory if it is missing from the data list if this is possibble?
'status tracking
Sub Status_Track()
Dim a As Long 'topic number
Dim Z As Long
Dim R As Long
Dim i As Long
Dim S As Long
Dim D As Long
Worksheets("RAW").Activate
R = Cells(Rows.Count, 2).End(xlUp).Row
C = Cells(1, Columns.Count).End(xlToLeft).Column
Z = 0
i = 2
Do Until i > R
'ident
If Cells(i, 2) = Worksheets("Data").Cells(i, 1) And (Cells(i, 13) = "ERKA") Then
Z = Worksheets("Data").Cells(i, 6) + 1
Worksheets("Data").Cells(i, 6).Value = Z
ElseIf Cells(i, 2) = Worksheets("Data").Cells(i, 1) And (Cells(i, 13) = "INBA") Then
'Inba
Z = Worksheets("Data").Cells(i, 7) + 1
Worksheets("Data").Cells(i, 7).Value = Z
ElseIf Cells(i, 2) = Worksheets("Data").Cells(i, 1) And (Cells(i, 13) = "ABGE") Then
'Abge
Z = Worksheets("Data").Cells(i, 8) + 1
Worksheets("Data").Cells(i, 8).Value = Z
ElseIf Cells(i, 2) = Worksheets("Data").Cells(i, 1) And (Cells(i, 13) = "GELO") Then
'Gelo
Z = Worksheets("Data").Cells(i, 5) + 1
Worksheets("Data").Cells(i, 5).Value = Z
ElseIf Cells(i, 2) = Worksheets("Data").Cells(i, 1) And (Cells(i, 13) = "UEBE") And (Cells(i, 11) = 0) Then
'UEBE
Z = Worksheets("Data").Cells(i, 9) + 1
Worksheets("Data").Cells(i, 9).Value = Z
ElseIf Cells(i, 11) = 1 And (Cells(i, 28) = "<1") Then
'1
Z = Worksheets("Data").Cells(i, 10) + 1
Worksheets("Data").Cells(i, 10).Value = Z
ElseIf Cells(i, 11) = 1 And (Cells(i, 28) = "6") Then
'6
Z = Worksheets("Data").Cells(i, 11) + 1
Worksheets("Data").Cells(i, 11).Value = Z
ElseIf Cells(i, 11) = 1 And (Cells(i, 28) = "9") Then
'9
Z = Worksheets("Data").Cells(i, 12) + 1
Worksheets("Data").Cells(i, 12).Value = Z
ElseIf Cells(i, 11) = 1 And (Cells(i, 28) = "10") Then
'10
Z = Worksheets("Data").Cells(i, 13) + 1
Worksheets("Data").Cells(i, 13).Value = Z
ElseIf Cells(i, 11) = 1 And (Cells(i, 28) = "15") Then
'15
Z = Worksheets("Data").Cells(i, 14) + 1
Worksheets("Data").Cells(i, 14).Value = Z
ElseIf Cells(i, 11) = 1 And (Cells(i, 28) = "30") Then
'30
Z = Worksheets("Data").Cells(i, 15) + 1
Worksheets("Data").Cells(i, 15).Value = Z
ElseIf Cells(i, 11) = 1 And (Cells(i, 28) = "50") Then
'50
Z = Worksheets("Data").Cells(i, 16) + 1
Worksheets("Data").Cells(i, 16).Value = Z
ElseIf Cells(i, 11) = 1 And (Cells(i, 28) = "60") Then
'60
Z = Worksheets("Data").Cells(i, 17) + 1
Worksheets("Data").Cells(i, 17).Value = Z
ElseIf Cells(i, 11) = 1 And (Cells(i, 28) = "70") Then
'70
Z = Worksheets("Data").Cells(i, 18) + 1
Worksheets("Data").Cells(i, 18).Value = Z
ElseIf Cells(i, 11) = 1 And (Cells(i, 28) = "80") Then
'80
Z = Worksheets("Data").Cells(i, 19) + 1
Worksheets("Data").Cells(i, 19).Value = Z
ElseIf Cells(i, 11) = 1 And (Cells(i, 28) = "90") Then
'90
Z = Worksheets("Data").Cells(i, 20) + 1
Worksheets("Data").Cells(i, 20).Value = Z
ElseIf Cells(i, 11) = 1 And (Cells(i, 28) = "97") Then
'97
Z = Worksheets("Data").Cells(i, 21) + 1
Worksheets("Data").Cells(i, 21).Value = Z
ElseIf Cells(i, 11) = 1 And (Cells(i, 28) = "100") Then
'100
Z = Worksheets("Data").Cells(i, 22) + 1
Worksheets("Data").Cells(i, 22).Value = Z
End If
Loop
End Sub

It could look something like that to find the corresponding identifier
Option Explicit 'must be the first line in a module: forces you to declare any variables before use
'status tracking
Sub Status_Track_Extended()
Dim wsRaw As Worksheet, wsData As Worksheet
Set wsRaw = ThisWorkbook.Worksheets("RAW")
Set wsData = ThisWorkbook.Worksheets("Data")
Dim LastRow As Long
LastRow = wsRaw.Cells(wsRaw.Rows.Count, 2).End(xlUp).Row 'find last row in sheet RAW
Dim FoundCell As Range, FoundRow As Long
Dim DataCol As Long
Dim i As Long
For i = 2 To LastRow 'start at row 2 up to last used row
'find corresponding row by identifier (column 2) in sheet Data
Set FoundCell = wsData.Columns(1).Find(wsRaw.Cells(i, 2))
If Not FoundCell Is Nothing Then 'only do the follwing if the identifier was found in sheet Data
FoundRow = FoundCell.Row
'ident
If wsRaw.Cells(i, 13) = "ERKA" Then
wsData.Cells(FoundRow, 6).Value = wsData.Cells(FoundRow, 6).Value + 1
ElseIf wsRaw.Cells(i, 13) = "INBA" Then
'Inba
wsData.Cells(FoundRow, 7).Value = wsData.Cells(FoundRow, 7).Value + 1
ElseIf wsRaw.Cells(i, 13) = "ABGE" Then
'Abge
wsData.Cells(FoundRow, 8).Value = wsData.Cells(FoundRow, 8).Value + 1
ElseIf wsRaw.Cells(i, 13) = "GELO" Then
'Gelo
wsData.Cells(FoundRow, 5).Value = wsData.Cells(FoundRow, 5).Value + 1
ElseIf wsRaw.Cells(i, 13) = "UEBE" And wsRaw.Cells(i, 11) = 0 Then
'UEBE
wsData.Cells(FoundRow, 9).Value = wsData.Cells(FoundRow, 9).Value + 1
ElseIf wsRaw.Cells(i, 11) = 1 Then
Select Case wsRaw.Cells(i, 28)
Case "<1"
wsData.Cells(FoundRow, 10).Value = wsData.Cells(FoundRow, 10).Value + 1
Case "6"
wsData.Cells(FoundRow, 11).Value = wsData.Cells(FoundRow, 11).Value + 1
Case "9"
wsData.Cells(FoundRow, 12).Value = wsData.Cells(FoundRow, 12).Value + 1
Case "10"
wsData.Cells(FoundRow, 13).Value = wsData.Cells(FoundRow, 13).Value + 1
Case "15"
wsData.Cells(FoundRow, 14).Value = wsData.Cells(FoundRow, 14).Value + 1
Case "30"
wsData.Cells(FoundRow, 15).Value = wsData.Cells(FoundRow, 15).Value + 1
Case "50"
wsData.Cells(FoundRow, 16).Value = wsData.Cells(FoundRow, 16).Value + 1
Case "60"
wsData.Cells(FoundRow, 17).Value = wsData.Cells(FoundRow, 17).Value + 1
Case "70"
wsData.Cells(FoundRow, 18).Value = wsData.Cells(FoundRow, 18).Value + 1
Case "80"
wsData.Cells(FoundRow, 19).Value = wsData.Cells(FoundRow, 19).Value + 1
Case "90"
wsData.Cells(FoundRow, 20).Value = wsData.Cells(FoundRow, 20).Value + 1
Case "97"
wsData.Cells(FoundRow, 21).Value = wsData.Cells(FoundRow, 21).Value + 1
Case "100"
wsData.Cells(FoundRow, 22).Value = wsData.Cells(FoundRow, 22).Value + 1
End Select
End If
Else 'error if identifier was not found
MsgBox "Identifier '" & wsRaw.Cells(i, 2) & "' could not be found in sheet 'Data'.", vbExclamation + vbOKOnly
End If
Next i
End Sub

Adding information into new rows in between occupied rows using VBA user form

I would need a code to program in adding new rows when there is an empty rows in between occupied rows.
For example, there is an empty row between the first and third occupied row.
Thus, i would need a code to program and insert information into the empty row in between the occupied rows using VBA user form.
I managed to create some coding but it seems not to be able to work. I hope anyone could help me.
Thank you.
Private Sub CommandAddButton1_Click()
lastrow = Sheets("Programme Status Summary").Range("J" & Rows.Count).End(xlUp).Row
Cells(lastrow + 1, "J").Value = TextBoxProjCode.Text
Cells(lastrow + 1, "E").Value = TextBoxProjName.Text
Cells(lastrow + 1, "C").Value = TextBoxSegment.Text
Cells(lastrow + 1, "F").Value = TextBoxSummary.Text
Cells(lastrow + 1, "G").Value = TextBoxAcc1.Text
Cells(lastrow + 1, "H").Value = TextBoxAcc2.Text
Cells(lastrow + 1, "I").Value = TextBoxProjM.Text
Cells(lastrow + 1, "K").Value = TextBoxCountry.Text
Cells(lastrow + 1, "L").Value = TextBoxRegulatory.Text
Cells(lastrow + 1, "M").Value = TextBoxRiskLvl.Text
Cells(lastrow + 1, "P").Value = TextBoxSchForecast.Text
Cells(lastrow + 1, "R").Value = TextBoxSchPar.Text
Cells(lastrow + 1, "S").Value = TextBoxImpact.Text
Cells(lastrow + 1, "T").Value = TextBoxCustNonRetail.Text
Cells(lastrow + 1, "U").Value = TextBoxCustRetail.Text
Cells(lastrow + 1, "V").Value = TextBoxOutsourcingImp.Text
Cells(lastrow + 1, "W").Value = TextBoxListImpt.Text
Cells(lastrow + 1, "X").Value = TextBoxKeyStatus.Text
Cells(lastrow + 1, "N").Value = TextBoxSchStart.Text
Cells(lastrow + 1, "O").Value = TextBoxSchEnd.Text
Cells(lastrow + 1, "Y").Value = TextBoxRagStatus.Text
Cells(lastrow + 1, "Z").Value = TextBoxRagCost.Text
Cells(lastrow + 1, "AA").Value = TextBoxRagBenefit.Text
End Sub

Using your code as basis, you'd need to add a loop, to find those line:
Private Sub CommandAddButton1_Click()
dim lngLastRow as Long
dim i as integer
dim wksWork as worksheet
set wksWork = thisworkbook.worksheets("Programme Status Summary")
lngLastRow = wksWork.Range("J" & wksWork.Rows.Count).End(xlUp).Row
for i = 1 to lngLastRow 'This starts in row 1, adjust accordingly
if wkswork.cells(i,1).value="" or wksWork.cells(i,1).value = vbNullstring then 'Checks in column A if there is any value given
with wksWork
.Cells(i, "J").Value = TextBoxProjCode.Text
.Cells(i, "E").Value = TextBoxProjName.Text
.Cells(i, "C").Value = TextBoxSegment.Text
.Cells(i, "F").Value = TextBoxSummary.Text
.Cells(i, "G").Value = TextBoxAcc1.Text
.Cells(i, "H").Value = TextBoxAcc2.Text
.Cells(i, "I").Value = TextBoxProjM.Text
.Cells(i, "K").Value = TextBoxCountry.Text
.Cells(i, "L").Value = TextBoxRegulatory.Text
.Cells(i, "M").Value = TextBoxRiskLvl.Text
.Cells(i, "P").Value = TextBoxSchForecast.Text
.Cells(i, "R").Value = TextBoxSchPar.Text
.Cells(i, "S").Value = TextBoxImpact.Text
.Cells(i, "T").Value = TextBoxCustNonRetail.Text
.Cells(i, "U").Value = TextBoxCustRetail.Text
.Cells(i, "V").Value = TextBoxOutsourcingImp.Text
.Cells(i, "W").Value = TextBoxListImpt.Text
.Cells(i, "X").Value = TextBoxKeyStatus.Text
.Cells(i, "N").Value = TextBoxSchStart.Text
.Cells(i, "O").Value = TextBoxSchEnd.Text
.Cells(i, "Y").Value = TextBoxRagStatus.Text
.Cells(i, "Z").Value = TextBoxRagCost.Text
.Cells(i, "AA").Value = TextBoxRagBenefit.Text
end with
end if
next i
End Sub

Resources