I've this macro in an UserForm to register accounting operations, after I finish the registration and I click the "x" button in the Userform my excel workbook close without asking me. I know this piece of code is the problem because my Userform do other things and these other things don't cause this problem.
Confirmar = MsgBox("¿Desea registrar la nueva operación contable?", vbYesNo)
If Confirmar = vbYes Then
Next_LibroDiario = WShe_LibroDiario.Cells(Rows.Count, 2).End(xlUp).Row + 1
If APP_RegistroContable.OptionButton_Débito = True Then
WShe_LibroDiario.Cells(Next_LibroDiario, 7) = APP_RegistroContable.Monto + 0
APP_RegistroContable.Monto = ""
ElseIf APP_RegistroContable.OptionButton_Crédito = True Then
WShe_LibroDiario.Cells(Next_LibroDiario, 8) = APP_RegistroContable.Monto + 0
APP_RegistroContable.Monto = ""
ElseIf APP_RegistroContable.OptionButton_Débito = False _
And APP_RegistroContable.OptionButton_Crédito = False _
Then
MsgBox "Please select an accounting item"
Exit Sub
End If
WShe_LibroDiario.Cells(Next_LibroDiario, 2) = APP_RegistroContable.Ctas_Bancarias
APP_RegistroContable.Ctas_Bancarias = ""
WShe_LibroDiario.Cells(Next_LibroDiario, 3) = CDate(APP_RegistroContable.Fecha)
APP_RegistroContable.Fecha = ""
WShe_LibroDiario.Cells(Next_LibroDiario, 4) = APP_RegistroContable.Recibo_CF
APP_RegistroContable.Recibo_CF = ""
WShe_LibroDiario.Cells(Next_LibroDiario, 5) = APP_RegistroContable.Nombre
APP_RegistroContable.Nombre = ""
WShe_LibroDiario.Cells(Next_LibroDiario, 6) = APP_RegistroContable.Auxiliar + 0
WShe_LibroDiario.Cells(Next_LibroDiario, 9) = APP_RegistroContable.Clasificación
APP_RegistroContable.Clasificación = ""
WShe_LibroDiario.Cells(Next_LibroDiario, 10) = APP_RegistroContable.Comentario
APP_RegistroContable.Comentario = ""
' This part creates an ID for the accounting operation using the date registered and the number of
' operations registered in that date
Last_ID = WShe_LibroDiario.Cells(Rows.Count, 2).End(xlUp).Row
Set Rang_Fecha = WShe_LibroDiario.Range("C8:C" & Last_ID)
Set Rang_ID = WShe_LibroDiario.Cells(Last_ID, 3)
Inte_IDGenerator = WorksheetFunction.CountIf(Rang_Fecha, Rang_ID)
WShe_LibroDiario.Cells(Last_ID, 1).Value = WShe_LibroDiario.Cells(Last_ID, 3).Value & "-0" & _
Inte_IDGenerator
MsgBox "The accounting operation is now in the system"
End if
I have a problem which is the data did not appear in the column. Only the first data. Name data should appear at column B9.
And fyi, name will appear at column A in last data.
The data will come out like this;
Where should I need to fix my error?
And the error I think is at this line -
ws.Cells(totalRows + 1, 1) = txtName.Text
Hope anyone of you can help me.
Thank you in advance.
Private Sub cmdAdd_Click()
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Master Data")
Dim Addme As Range, str As String, totalRows As Long
Set Addme = ws.Cells(ws.Rows.Count, 3).End(xlUp).Offset(1, 0)
Application.ScreenUpdating = False
If Me.txtName = "" Or Me.cboAmount = "" Or Me.cboCeti = "" Then
MsgBox "There is insufficient data, Please return and add the needed information"
Exit Sub
End If
totalRows = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
totalRows = Application.WorksheetFunction.Max(totalRows, 3)
ws.Cells(totalRows + 1, 1) = txtName.Text
If cbWhatsapp.Value = True Then
str = "Whatsapp, "
End If
If cbSMS.Value = True Then
str = str & "SMS, "
End If
If cbEmail.Value = True Then
str = str & "Email, "
End If
If cbFacebook.Value = True Then
str = str & "Facebook, "
End If
If cbPhoneCall.Value = True Then
str = str & "Phone Call, "
End If
str = Left(str, Len(str) - 2)
ws.Cells(totalRows + 1, 2) = str
If optYes.Value = True Then
ws.Cells(totalRows + 1, 3) = "Yes"
ElseIf optNo.Value = True Then
ws.Cells(totalRows + 1, 3) = "No"
End If
ws.Cells(totalRows + 1, 4) = cboAmount.Value
ws.Cells(totalRows + 1, 5) = cboCeti.Value
ws.Cells(totalRows + 1, 6) = txtPhone.Text
ws.Cells(totalRows + 1, 7) = txtEmail.Text
ws.Range("B9:H10000").Sort Key1:=Range("F9"), Order1:=xlAscending, Header:=xlGuess
MsgBox "Your data was successfully added"
Sheet1.Select
On Error GoTo 0
Exit Sub
End Sub
If Worksheets("HR-Calc").Range("L2") = "01+" Then
Application.ScreenUpdating = False
Range("A7").FormulaR1C1 = "1"
Range("A8").FormulaR1C1 = "2"
Range("A9").FormulaR1C1 = "3"
Range("A10").FormulaR1C1 = "4"
Range("A11").FormulaR1C1 = "5"
Range("A12").FormulaR1C1 = "6"
Range("A13").FormulaR1C1 = "7"
Range("A14").FormulaR1C1 = "8"
Range("A15").FormulaR1C1 = "9"
Range("A16").FormulaR1C1 = "10"
Range("A17").FormulaR1C1 = "11"
Range("A18").FormulaR1C1 = "12"
Range("A19").FormulaR1C1 = "13"
Range("A20").FormulaR1C1 = "14"
Range("A21").FormulaR1C1 = "15"
Range("A22").FormulaR1C1 = "16"
Range("A23").FormulaR1C1 = "17"
Range("A24").FormulaR1C1 = "18"
Range("A25").FormulaR1C1 = "19"
Range("A26").FormulaR1C1 = "20"
Range("A27").FormulaR1C1 = "21"
Range("A28").FormulaR1C1 = "22"
Range("A29").FormulaR1C1 = "23"
Range("A30").FormulaR1C1 = "24"
Range("A31").FormulaR1C1 = "25"
Range("A32").FormulaR1C1 = "26"
Range("A33").FormulaR1C1 = "27"
Range("A34").FormulaR1C1 = "28"
Range("A35").FormulaR1C1 = "29"
Range("A36").FormulaR1C1 = "30"
Range("A37").FormulaR1C1 = "31"
Range("A38").FormulaR1C1 = "32"
Range("A39").FormulaR1C1 = "33"
Range("A40").FormulaR1C1 = "34"
Range("A41").FormulaR1C1 = "35"
Range("A42").FormulaR1C1 = "36"
' maximum nuber of strings is currently 36. To increase follow pattern shown ie A43/37 , A44/38 etc etc.
'if maximum is changed it must be changed in all string format sections 01, 01/02, 01/02/03, & 01/02/03/04
If Worksheets("HR-Calc").Range("F2") = "STAGGER" Then
Range("C7").FormulaR1C1 = "STR.01+"
Range("C8").FormulaR1C1 = "STR.02+"
Range("C9").FormulaR1C1 = "STR.03+"
Range("C10").FormulaR1C1 = "STR.04+"
Range("C11").FormulaR1C1 = "STR.05+"
Range("C12").FormulaR1C1 = "STR.06+"
Range("C13").FormulaR1C1 = "STR.07+"
Range("C14").FormulaR1C1 = "STR.08+"
Range("C15").FormulaR1C1 = "STR.09+"
Range("C16").FormulaR1C1 = "STR.10+"
Range("C17").FormulaR1C1 = "STR.11+"
Range("C18").FormulaR1C1 = "STR.12+"
Range("C19").FormulaR1C1 = "STR.13+"
Range("C20").FormulaR1C1 = "STR.14+"
Range("C21").FormulaR1C1 = "STR.15+"
Range("C22").FormulaR1C1 = "STR.16+"
Range("C23").FormulaR1C1 = "STR.17+"
Range("C24").FormulaR1C1 = "STR.18+"
Range("C25").FormulaR1C1 = "STR.19+"
Range("C26").FormulaR1C1 = "STR.20+"
Range("C27").FormulaR1C1 = "STR.21+"
Range("C28").FormulaR1C1 = "STR.22+"
Range("C29").FormulaR1C1 = "STR.23+"
Range("C30").FormulaR1C1 = "STR.24+"
Range("C31").FormulaR1C1 = "STR.25+"
Range("C32").FormulaR1C1 = "STR.26+"
Range("C33").FormulaR1C1 = "STR.27+"
Range("C34").FormulaR1C1 = "STR.28+"
Range("C35").FormulaR1C1 = "STR.29+"
Range("C36").FormulaR1C1 = "STR.30+"
Range("C37").FormulaR1C1 = "STR.31+"
Range("C38").FormulaR1C1 = "STR.32+"
Range("C39").FormulaR1C1 = "STR.33+"
Range("C40").FormulaR1C1 = "STR.34+"
Range("C41").FormulaR1C1 = "STR.35+"
Range("C42").FormulaR1C1 = "STR.36+"
Else
Range("C7").FormulaR1C1 = "01+"
Range("C8").FormulaR1C1 = "02+"
Range("C9").FormulaR1C1 = "03+"
Range("C10").FormulaR1C1 = "04+"
Range("C11").FormulaR1C1 = "05+"
Range("C12").FormulaR1C1 = "06+"
Range("C13").FormulaR1C1 = "07+"
Range("C14").FormulaR1C1 = "08+"
Range("C15").FormulaR1C1 = "09+"
Range("C16").FormulaR1C1 = "10+"
Range("C17").FormulaR1C1 = "11+"
Range("C18").FormulaR1C1 = "12+"
Range("C19").FormulaR1C1 = "13+"
Range("C20").FormulaR1C1 = "14+"
Range("C21").FormulaR1C1 = "15+"
Range("C22").FormulaR1C1 = "16+"
Range("C23").FormulaR1C1 = "17+"
Range("C24").FormulaR1C1 = "18+"
Range("C25").FormulaR1C1 = "19+"
Range("C26").FormulaR1C1 = "20+"
Range("C27").FormulaR1C1 = "21+"
Range("C28").FormulaR1C1 = "22+"
Range("C29").FormulaR1C1 = "23+"
Range("C30").FormulaR1C1 = "24+"
Range("C31").FormulaR1C1 = "25+"
Range("C32").FormulaR1C1 = "26+"
Range("C33").FormulaR1C1 = "27+"
Range("C34").FormulaR1C1 = "28+"
Range("C35").FormulaR1C1 = "29+"
Range("C36").FormulaR1C1 = "30+"
Range("C37").FormulaR1C1 = "31+"
Range("C38").FormulaR1C1 = "32+"
Range("C39").FormulaR1C1 = "33+"
Range("C40").FormulaR1C1 = "34+"
Range("C41").FormulaR1C1 = "35+"
Range("C42").FormulaR1C1 = "36+"
End If
' only adds the positive string numbers to the list, all negative will be added later on in code
' ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^---------------------------- 01+
' ---------------------------------------------------------------------------- 01/02+
ElseIf Worksheets("HR-Calc").Range("L2") = "01/02+" Then
Application.ScreenUpdating = False
'
Range("A7").FormulaR1C1 = "1"
Range("A8").FormulaR1C1 = "2"
Range("A9").FormulaR1C1 = "3"
Range("A10").FormulaR1C1 = "4"
Range("A11").FormulaR1C1 = "5"
Range("A12").FormulaR1C1 = "6"
Range("A13").FormulaR1C1 = "7"
Range("A14").FormulaR1C1 = "8"
Range("A15").FormulaR1C1 = "9"
Range("A16").FormulaR1C1 = "10"
Range("A17").FormulaR1C1 = "11"
Range("A18").FormulaR1C1 = "12"
Range("A19").FormulaR1C1 = "13"
Range("A20").FormulaR1C1 = "14"
Range("A21").FormulaR1C1 = "15"
Range("A22").FormulaR1C1 = "16"
Range("A23").FormulaR1C1 = "17"
Range("A24").FormulaR1C1 = "18"
If Worksheets("HR-Calc").Range("F2") = "STAGGER" Then
Range("C7").FormulaR1C1 = "STR.01/02+"
Range("C8").FormulaR1C1 = "STR.03/04+"
Range("C9").FormulaR1C1 = "STR.05/06+"
Range("C10").FormulaR1C1 = "STR.07/08+"
Range("C11").FormulaR1C1 = "STR.09/10+"
Range("C12").FormulaR1C1 = "STR.11/12+"
Range("C13").FormulaR1C1 = "STR.13/14+"
Range("C14").FormulaR1C1 = "STR.15/16+"
Range("C15").FormulaR1C1 = "STR.17/18+"
Range("C16").FormulaR1C1 = "STR.19/20+"
Range("C17").FormulaR1C1 = "STR.21/22+"
Range("C18").FormulaR1C1 = "STR.23/24+"
Range("C19").FormulaR1C1 = "STR.25/26+"
Range("C20").FormulaR1C1 = "STR.27/28+"
Range("C21").FormulaR1C1 = "STR.29/30+"
Range("C22").FormulaR1C1 = "STR.31/32+"
Range("C23").FormulaR1C1 = "STR.33/34+"
Range("C24").FormulaR1C1 = "STR.35/36+"
Else
Range("C7").FormulaR1C1 = "01/02+"
Range("C8").FormulaR1C1 = "03/04+"
Range("C9").FormulaR1C1 = "05/06+"
Range("C10").FormulaR1C1 = "07/08+"
Range("C11").FormulaR1C1 = "09/10+"
Range("C12").FormulaR1C1 = "11/12+"
Range("C13").FormulaR1C1 = "13/14+"
Range("C14").FormulaR1C1 = "15/16+"
Range("C15").FormulaR1C1 = "17/18+"
Range("C16").FormulaR1C1 = "19/20+"
Range("C17").FormulaR1C1 = "21/22+"
Range("C18").FormulaR1C1 = "23/24+"
Range("C19").FormulaR1C1 = "25/26+"
Range("C20").FormulaR1C1 = "27/28+"
Range("C21").FormulaR1C1 = "29/30+"
Range("C22").FormulaR1C1 = "31/32+"
Range("C23").FormulaR1C1 = "33/34+"
Range("C24").FormulaR1C1 = "35/36+"
End If
' only adds the positive string numbers to the list, all negative will be added later on in code
' ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^---------------------------- 01/02+
code shown only has half of the macro, 01+, 01/02+ are shown however there is also 01/02/03+ and 01/02/03/04+ as well . Currently the code above works just fine, The only issue is that if I need more than 36 items in my list I have to run the macro then go in and manually add more data points. I've had to expand this macro 3 times already because of different projects. Cell M2 has the maximum number the list would go to (Currently 36), is there a faster way to do this other than my manual method, that allows users to input whatever number they need?
UPDATE: loop code (with some help from Ralph). much cleaner method and a lot less code
' ---------------------------------------------------------------------------- 01+ string format
If Range("L2") = "01+" Then
Dim i As Integer
For i = 1 To Range("m2")
Cells(6 + i, 1).Value = 0 + i
If Worksheets("HR-Calc").Range("F2") = "STAGGER" Then
Range("c" & 6 + i).FormulaR1C1 = "STR." & Right("0" & i, 2) & "+"
Else
Range("c" & 6 + i).FormulaR1C1 = Right("0" & i, 2) & "+"
End If
Next i
' ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^---------------------------- 01+
' ---------------------------------------------------------------------------- 01/02+ string format
ElseIf Range("L2") = "01/02+" Then
maxn = Range("m2") / 2
For i = 1 To maxn
Cells(6 + i, 1).Value = 0 + i
If Worksheets("HR-Calc").Range("F2") = "STAGGER" Then
Range("c" & 6 + i).FormulaR1C1 = "STR." & Right("0" & (2 * i) - 1, 2) & "/" & Right("0" & (2 * i), 2) & "+"
Else
Range("c" & 6 + i).FormulaR1C1 = Right("0" & (2 * i) - 1, 2) & "/" & Right("0" & (2 * i), 2) & "+"
End If
Next i
' ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^---------------------------- 01/02+
' ---------------------------------------------------------------------------- 01/02/03+ string format
ElseIf Range("L2") = "01/02/03+" Then
maxn = Range("m2") / 3
For i = 1 To maxn
Cells(6 + i, 1).Value = 0 + i
If Worksheets("HR-Calc").Range("F2") = "STAGGER" Then
Range("c" & 6 + i).FormulaR1C1 = "STR." & Right("0" & (3 * i) - 2, 2) & "/" & Right("0" & (3 * i) - 1, 2) & "/" & Right("0" & (3 * i), 2) & "+"
Else
Range("c" & 6 + i).FormulaR1C1 = Right("0" & (3 * i) - 2, 2) & "/" & Right("0" & (3 * i) - 1, 2) & "/" & Right("0" & (3 * i), 2) & "+"
End If
Next i
' ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^---------------------------- 01/02/03+
' ---------------------------------------------------------------------------- 01/02/03/04+ string format
ElseIf Range("L2") = "01/02/03/04+" Then
maxn = Round(Range("m2") / 4, 0)
For i = 1 To maxn
Cells(6 + i, 1).Value = 0 + i
If Worksheets("HR-Calc").Range("F2") = "STAGGER" Then
Range("c" & 6 + i).FormulaR1C1 = "STR." & Right("0" & (4 * i) - 3, 2) & "/" & Right("0" & (4 * i) - 2, 2) & "/" & Right("0" & (4 * i) - 1, 2) & "/" & Right("0" & (4 * i), 2) & "+"
Else
Range("c" & 6 + i).FormulaR1C1 = Right("0" & (4 * i) - 3, 2) & "/" & Right("0" & (4 * i) - 2, 2) & "/" & Right("0" & (4 * i) - 1, 2) & "/" & Right("0" & (4 * i), 2) & "+"
End If
Next i
' ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^---------------------------- 01/02/03/04+
End If
What you are doing is a bit painful. Begin by replacing blocks of code like:
Range("A7").FormulaR1C1 = "1"
Range("A8").FormulaR1C1 = "2"
Range("A9").FormulaR1C1 = "3"
Range("A10").FormulaR1C1 = "4"
Range("A11").FormulaR1C1 = "5"
Range("A12").FormulaR1C1 = "6"
Range("A13").FormulaR1C1 = "7"
Range("A14").FormulaR1C1 = "8"
Range("A15").FormulaR1C1 = "9"
Range("A16").FormulaR1C1 = "10"
Range("A17").FormulaR1C1 = "11"
Range("A18").FormulaR1C1 = "12"
Range("A19").FormulaR1C1 = "13"
Range("A20").FormulaR1C1 = "14"
Range("A21").FormulaR1C1 = "15"
Range("A22").FormulaR1C1 = "16"
Range("A23").FormulaR1C1 = "17"
Range("A24").FormulaR1C1 = "18"
Range("A25").FormulaR1C1 = "19"
Range("A26").FormulaR1C1 = "20"
Range("A27").FormulaR1C1 = "21"
Range("A28").FormulaR1C1 = "22"
Range("A29").FormulaR1C1 = "23"
Range("A30").FormulaR1C1 = "24"
Range("A31").FormulaR1C1 = "25"
Range("A32").FormulaR1C1 = "26"
Range("A33").FormulaR1C1 = "27"
Range("A34").FormulaR1C1 = "28"
Range("A35").FormulaR1C1 = "29"
Range("A36").FormulaR1C1 = "30"
Range("A37").FormulaR1C1 = "31"
Range("A38").FormulaR1C1 = "32"
Range("A39").FormulaR1C1 = "33"
Range("A40").FormulaR1C1 = "34"
Range("A41").FormulaR1C1 = "35"
Range("A42").FormulaR1C1 = "36"
with:
Range("A7:A42").Formula = "=rows($1:1)"
Range("A7:A42").Value = Range("A7:A42").Value
or:
With Range("A7:A42")
.Formula = "=rows($1:1)"
.Value = .Value
End With
It will be easier to replace the 42 with a parameter than to add more lines of code.
For i = 1 to 36
Range("C" & 6 + i).FormulaR1C1 = Right("0" & i, 2) & "+"
Next i
I'm trying to write a program for a userform in excel for editing chart title and other things. I want write a code that uses special characters i.e. {like this} and changes the text inside the cutely brackets to subscript and I want to able to do this multiple times:
The following code this but only for the first occurrence.
Public Font_Name As String, Font_Style As String, Half_Height As Integer
Sub CommandButton1_Click()
'********************Define Standardized Plot Settings******************
Font_Name = "Arial"
Font_Style = "Normal"
Title_Font_Size = 28
Axes_Label_Font_Size = 22
Tick_Lable_Font_Size = 20
PlotArea_Border_Color_R = 0
PlotArea_Border_Color_G = 0
PlotArea_Border_Color_B = 0
PlotArea_Border_Weight = 3
PlotArea_Border_Weight_Pass = PlotArea_Border_Weight
Grid_Color_R = 150
Grid_Color_G = 150
Grid_Color_B = 150
Grid_Weight = 2
Grid_Weight_Pass = Grid_Weight
'*****************End Define Standardized Plot Settings*****************
'****************************Format the plot********************************
'----------------------------Format the Title-------------------------------
'*****Searches Char Title for {} and replaces everything indside as subscript***
With ActiveChart
.HasTitle = True
.ChartTitle.Text = Me.Chart_Title.Text
.ChartTitle.Characters.Font.Name = Font_Name
.ChartTitle.Characters.Font.FontStyle = Font_Style
.ChartTitle.Characters.Font.Size = Title_Font_Size 'works
If Me.FontOveride <> "" Then
.ChartTitle.Characters.Font.Size = Me.FontOveride
Else
.ChartTitle.Characters.Font.Size = Title_Font_Size 'works
End If
searchString = Me.Chart_Title.Text
Char1 = "{"
Char2 = "}"
For i = 1 To Len(searchString)
If Mid(searchString, i, 1) = Char1 Then
startPos = i
Exit For
Else:
End If
Next i
For j = 1 To Len(searchString)
If Mid(searchString, j, 1) = Char2 Then
endPos = j
Exit For
Else:
End If
Next j
If startPos >= 1 Or endPos >= 1 Then
.ChartTitle.Characters(startPos, endPos - startPos).Font.Subscript = True
.ChartTitle.Characters(startPos, 1).Delete
.ChartTitle.Characters(endPos - 1, 1).Delete
Else:
End If
End With
'***************************************************************************
'***************************************************************************
'----------------------------Format the X Axis-------------------------------
With ActiveChart.Axes(xlCategory)
.HasTitle = True
.AxisTitle.Characters.Text = Me.X_Axis_Title
.AxisTitle.Characters.Font.Name = Font_Name
.AxisTitle.Characters.Font.FontStyle = Font_Style
.AxisTitle.Characters.Font.Size = Axes_Label_Font_Size
.TickLabels.Font.Name = Font_Name
.TickLabels.Font.FontStyle = Font_Style
.TickLabels.Font.Size = Tick_Lable_Font_Size
.MajorTickMark = xlTickMarkNone
.MinimumScale = Me.X_Axis_Start
.MaximumScale = Me.X_Axis_Stop
.MajorUnit = Me.X_Axis_Step
.CrossesAt = Me.X_Axis_Start
.HasMajorGridlines = True
.MajorGridlines.Border.Color = RGB(Grid_Color_R, Grid_Color_G, Grid_Color_B)
.MajorGridlines.Border.Weight = Grid_Weight_Pass
.Border.Color = vbBlack
'*****Searches X-Axis for {} and replaces everything indside as subscript*******
searchString = Me.X_Axis_Title
Char1 = "{"
Char2 = "}"
For i = 1 To Len(searchString)
If Mid(searchString, i, 1) = Char1 Then
Pos1 = i
Exit For
Else:
'End If
End If
Next i
For j = 1 To Len(searchString)
If Mid(searchString, j, 1) = Char2 Then
Pos2 = j
Exit For
Else:
'End If
End If
Next j
If Pos1 >= 1 And Pos2 >= 1 Then
.AxisTitle.Characters(Pos1, Pos2 - Pos1).Font.Subscript = True
.AxisTitle.Characters(Pos1, 1).Delete
.AxisTitle.Characters(Pos2 - 1, 1).Delete
Else:
End If
End With
'----------------------------Format the Y Axis-------------------------------
With ActiveChart.Axes(xlValue)
.HasTitle = True
.AxisTitle.Characters.Text = Me.Y_Axis_Title
.AxisTitle.Characters.Font.Name = Font_Name
.AxisTitle.Characters.Font.FontStyle = Font_Style
.AxisTitle.Characters.Font.Size = Axes_Label_Font_Size
.TickLabels.Font.Name = Font_Name
.TickLabels.Font.FontStyle = Font_Style
.TickLabels.Font.Size = Tick_Lable_Font_Size
On Error GoTo Skip
Decimal_Position = Len(Me.Y_Axis_Step.Text) - WorksheetFunction.Search(".", Me.Y_Axis_Step.Text)
Format_String = "#,##0." & WorksheetFunction.Rept("0", Decimal_Position)
.TickLabels.NumberFormat = Format_String
GoTo Skip2
Skip:
On Error GoTo 0
.TickLabels.NumberFormat = "#,##0"
Skip2:
.MajorTickMark = xlTickMarkNone
.MinimumScale = Me.Y_Axis_Start
.MaximumScale = Me.Y_Axis_Stop
.MajorUnit = Me.Y_Axis_Step
.CrossesAt = Me.Y_Axis_Start
.HasMajorGridlines = True
.MajorGridlines.Border.Color = RGB(Grid_Color_R, Grid_Color_G, Grid_Color_B)
.MajorGridlines.Border.Weight = Grid_Weight_Pass
.Border.Color = vbBlack
'*****Searches Y Axis for {} and replaces everything indside as subscript*******
searchString = Me.Y_Axis_Title
Char1 = "{"
Char2 = "}"
For i = 1 To Len(searchString)
If Mid(searchString, i, 1) = Char1 Then
Pos3 = i
Exit For
Else:
'End If
End If
Next i
For j = 1 To Len(searchString)
If Mid(searchString, j, 1) = Char2 Then
Pos4 = j
Exit For
Else:
'End If
End If
Next j
If Pos3 >= 1 And Pos4 >= 1 Then
.AxisTitle.Characters(Pos3, Pos4 - Pos3).Font.Subscript = True
.AxisTitle.Characters(Pos3, 1).Delete
.AxisTitle.Characters(Pos4 - 1, 1).Delete
Else:
End If
End With
'****************************End Format the Plot*******************************
You can use regular expressions with the pattern {[\w]*}.
If you want to use early binding, then it requires reference to Microsoft VBScript Regular Expressions 5.5.
RegEx will give you, in addition to other information the start position & length of each substring, which you can then use to apply the subscript or other formatting as required.
Sub regTest()
Dim R As Object 'New RegExp
Dim matches As Object 'MatchCollection
Dim m As Variant
Dim str As String
Set R = CreateObject("VBScript.RegExp")
str = "hello {world} this is my {title}"
R.Pattern = "{[\w]*}"
R.Global = True
R.IgnoreCase = True
If R.test(str) Then
Set matches = R.Execute(str)
For Each m In matches
Debug.Print m.Value
Debug.Print "Starts at: " & m.FirstIndex
Debug.Print "Lenght: " & m.Length
Next
End If
End Sub
I have the following code and VBA is giving me a "Next Without For" Error when I definitely have both. I know that VBA can list errors that are not exactly the same as what it says they are, but I can't find any other closed loops. If someone could check this out, that would be awesome! Thanks:
Option Explicit
Sub HW09()
Dim ng As Integer
Dim v As String
Dim lg As String
Dim ca As Integer
Dim sd As Integer
Dim c As Integer
Dim r As Integer
c = 2
Do
ng = InputBox("Please enter the student's numerical grade.")
If ng < 0 Then
ng = 0
If ng > 100 Then
ng = 100
End If
Cells(c, 2).Value (ng)
c = c + 1
v = InputBox("Would you like to enter another grade? Type 'Y' for yes and 'N' for no.")
If v = "N" Then Exit Do
End If
Loop
Cells(1, 2).Value ("Numerical Grade")
Cells(1, 1).Value ("Letter Grade")
For r = 1 To c
If Cells(r, 2) >= 90 Then
lg = "A"
Cells(r, 1).Value (lg)
If Cells(r, 2) >= 80 Then
lg = "B"
Cells(c, 1).Value (lg)
If Cells(r, 2) >= 70 Then
lg = "C"
Cells(c, 1).Value (lg)
If Cells(r, 2) >= 60 Then
lg = "D"
Cells(c, 1).Value (lg)
Else
lg = "F"
Cells(c, 1).Value (lg)
End If
r = r + 1
Next r
c = c - 1
ca = Application.WorksheetFunction.Average("(1,2):(1,c)")
If ca >= 90 Then
lg = "A"
If ca >= 80 Then
lg = "B"
If ca >= 70 Then
lg = "C"
If ca >= 60 Then
lg = "D"
Else
lg = "F"
End If
MsgBox ("The average letter grade for these " & (c) & " students is " & (lg) & ".")
sd = c * (Application.WorksheetFunction.Sum("(1, 2)(1, c) ^ 2)")-Application.WorksheetFunction.Sum("(1, 2)(1, c)") ^ 2 / (c * (c - 1)))
MsgBox ("The standard deviation for these grades is" & (sd) & ".")
End Sub
Your problem is you are doing If... Then... If... Then... instead of If... Then... ElseIf... Then...
If Cells(r, 2) >= 90 Then
lg = "A"
Cells(r, 1).Value (lg)
ElseIf Cells(r, 2) >= 80 Then
lg = "B"
Cells(c, 1).Value (lg)
ElseIf Cells(r, 2) >= 70 Then
lg = "C"
Cells(c, 1).Value (lg)
ElseIf Cells(r, 2) >= 60 Then
lg = "D"
Cells(c, 1).Value (lg)
Else
lg = "F"
Cells(c, 1).Value (lg)
End If
Every IF statement needs to be terminated with an ENDIF.
Within the FOR/NEXT loop you have 4 IFs, one ELSE and one ENDIF
this needs to be changed to:
IF Condition1 THEN
'code
ELSEIF Condition2 THEN
'code
ELSEIF Condition3 THEN
'code
ELSEIF Condition4 THEN
'code
ELSE 'All other possibilities
'code
ENDIF
I think the nested If statements inside For r = 1 to c... don't close properly? Generally, each If also requires an End If, and you only have one End If statement. This is causing the compiler to reach the Next r statement while it's still "inside" an If block, thus the error raises, and makes sense.
You may look in to using a Select Case switch instead of nesting several If/Then statements. In my experience, they're more easy to interpret when you're debugging. Something like:
For r = 1 To c
Select Case Cells(r,2)
Case >= 90
lg = "A"
Case >= 80
lg = "B"
Case >= 70
lg = "C"
Case >= 60
lg = "D"
Case Else
lg = "F"
End Select
Cells(r,1).Value = lg
r = r + 1 '## You may want to omit this line, see my comments.
Next r
Note: You may want to omit the r = r+1 unless you're intending to skip every other record, the Next statement automatically increments r by a value of 1 unless otherwise specified.
If you do intend to skip every other record, you should do For r = 1 to c Step 2 and likewise omit the r = r+1 .
This error occurs when the condition is not closed.
You must don't forger close if conditions.
for example:
Public Sub start_r()
LastRow = SPT_DB.Range("D" & Rows.count).End(xlUp).Row
Dim i As Long
For i = 3 To 132
State = Cells(1, i)
Dim j As Long
For j = 2 To LastRow
m = SPT_DB.Cells(j, 4).Value
z = SPT_DB.Cells(j, 5).Value
n1 = SPT_DB.Cells(j, 6).Value
fc = SPT_DB.Cells(j, 7).Value
am = SPT_DB.Cells(j, 8).Value
sp = SPT_DB.Cells(j, 10).Value
sr = SPT_DB.Cells(j, 11).Value
liq = SPT_DB.Cells(j, 13).Value
num1 = Val(Left(State, 1))
num2 = Val(Mid(State, 3, 1))
num3 = Val(Mid(State, 5, 1))
num4 = Val(Mid(State, 7, 1))
num5 = Val(Mid(State, 9, 1))
Dim spt_class As spt_class
Set spt_class = New spt_class
Select Case num1
Case Is = 1: Call spt_class.rd_r1
Case Is = 2: Call spt_class.rd_r2
Case Is = 3: Call spt_class.rd_r3
Case Is = 4: Call spt_class.rd_r4
End Select
Select Case num2
Case Is = 1: Call spt_class.msf_r1
Case Is = 2: Call spt_class.msf_r2
Case Is = 3: Call spt_class.msf_r3
Case Is = 4: Call spt_class.msf_r4
Case Is = 5: Call spt_class.msf_r5
Case Is = 6: Call spt_class.msf_r6
End Select
Select Case num3
Case Is = 0:
Case Is = 1: Call spt_class.n1_cs_r1
Case Is = 2: Call spt_class.n1_cs_r2
Case Is = 3: Call spt_class.n1_cs_r3
End Select
Select Case num4
Case Is = 0:
Case Is = 1: Call spt_class.dr_r1
Case Is = 2: Call spt_class.dr_r2
Case Is = 3: Call spt_class.dr_r3
Case Is = 4: Call spt_class.dr_r4
End Select
Select Case num5
Case Is = 1: Call spt_class.crr_r1
Case Is = 2: Call spt_class.crr_r2
Case Is = 3: Call spt_class.crr_r3
Case Is = 4: Call spt_class.crr_r4
Case Is = 5: Call spt_class.crr_r5
Case Is = 6: Call spt_class.crr_r6
Case Is = 7: Call spt_class.crr_r7
Case Is = 8: Call spt_class.crr_r8
Case Is = 9: Call spt_class.crr_r9
End Select
Call spt_class.lvr_r
Next j
If cnt_f_1_all = 0 Then
Cells(4, i) = 0
Else
Cells(4, i) = cnt_f_1_liq * 100 / cnt_f_1_all
Cells(4, i).NumberFormat = "#,##0.00"
End If
If cnt_f_2_all = 0 Then
Cells(5, i) = 0
Else
Cells(5, i) = cnt_f_2_liq * 100 / cnt_f_2_all
Cells(5, i).NumberFormat = "#,##0.00"
End If
If cnt_f_3_all = 0 Then
Cells(6, i) = 0
Else
Cells(6, i) = cnt_f_3_liq * 100 / cnt_f_3_all
Cells(6, i).NumberFormat = "#,##0.00"
End If
If cnt_f_4_all = 0 Then
Cells(7, i) = 0
Else
Cells(7, i) = cnt_f_4_liq * 100 / cnt_f_4_all
Cells(7, i).NumberFormat = "#,##0.00"
End If
If cnt_f_n0_1_all = 0 Then
Cells(14, i) = 0
Else
Cells(14, i) = cnt_f_n0_1_liq * 100 / cnt_f_n0_1_all
Cells(14, i).NumberFormat = "#,##0.00"
End If
If cnt_f_n0_2_all = 0 Then
Cells(15, i) = 0
Else
Cells(15, i) = cnt_f_n0_2_liq * 100 / cnt_f_n0_2_all
Cells(15, i).NumberFormat = "#,##0.00"
End If
If cnt_f_n0_3_all = 0 Then
Cells(16, i) = 0
Else
Cells(16, i) = cnt_f_n0_3_liq * 100 / cnt_f_n0_3_all
Cells(16, i).NumberFormat = "#,##0.00"
End If
If cnt_f_n0_4_all = 0 Then
Cells(17, i) = 0
Else
Cells(17, i) = cnt_f_n0_4_liq * 100 / cnt_f_n0_4_all
Cells(17, i).NumberFormat = "#,##0.00"
End If
If cnt_f_n1_1_all = 0 Then
Cells(24, i) = 0
Else
Cells(24, i) = cnt_f_n1_1_liq * 100 / cnt_f_n1_1_all
Cells(24, i).NumberFormat = "#,##0.00"
End If
If cnt_f_n1_2_all = 0 Then
Cells(25, i) = 0
Else
Cells(25, i) = cnt_f_n1_2_liq * 100 / cnt_f_n1_2_all
Cells(25, i).NumberFormat = "#,##0.00"
End If
If cnt_f_n1_3_all = 0 Then
Cells(26, i) = 0
Else
Cells(26, i) = cnt_f_n1_3_liq * 100 / cnt_f_n1_3_all
Cells(26, i).NumberFormat = "#,##0.00"
End If
If cnt_f_n1_4_all = 0 Then
Cells(27, i) = 0
Else
Cells(27, i) = cnt_f_n1_4_liq * 100 / cnt_f_n1_4_all
Cells(27, i).NumberFormat = "#,##0.00"
End If
If cnt_f_n2_1_all = 0 Then
Cells(34, i) = 0
Else
Cells(34, i) = cnt_f_n2_1_liq * 100 / cnt_f_n2_1_all
Cells(34, i).NumberFormat = "#,##0.00"
End If
If cnt_f_n2_2_all = 0 Then
Cells(35, i) = 0
Else
Cells(35, i) = cnt_f_n2_2_liq * 100 / cnt_f_n2_2_all
Cells(35, i).NumberFormat = "#,##0.00"
End If
If cnt_f_n2_3_all = 0 Then
Cells(36, i) = 0
Else
Cells(36, i) = cnt_f_n2_3_liq * 100 / cnt_f_n2_3_all
Cells(36, i).NumberFormat = "#,##0.00"
End If
If cnt_f_n2_4_all = 0 Then
Cells(37, i) = 0
Else
Cells(37, i) = cnt_f_n2_4_liq * 100 / cnt_f_n2_4_all
Cells(37, i).NumberFormat = "#,##0.00"
End If
If cnt_f_n3_1_all = 0 Then
Cells(44, i) = 0
Else
Cells(44, i) = cnt_f_n3_1_liq * 100 / cnt_f_n3_1_all
Cells(44, i).NumberFormat = "#,##0.00"
End If
If cnt_f_n3_2_all = 0 Then
Cells(45, i) = 0
Else
Cells(45, i) = cnt_f_n3_2_liq * 100 / cnt_f_n3_2_all
Cells(45, i).NumberFormat = "#,##0.00"
End If
If cnt_f_n3_3_all = 0 Then
Cells(46, i) = 0
Else
Cells(46, i) = cnt_f_n3_3_liq * 100 / cnt_f_n3_3_all
Cells(46, i).NumberFormat = "#,##0.00"
End If
If cnt_f_n3_4_all = 0 Then
Cells(47, i) = 0
Else
Cells(47, i) = cnt_f_n3_4_liq * 100 / cnt_f_n3_4_all
Cells(47, i).NumberFormat = "#,##0.00"
End If
Next i
cnt_f_1_liq = 0
cnt_f_2_liq = 0
cnt_f_3_liq = 0
cnt_f_4_liq = 0
cnt_f_1_all = 0
cnt_f_2_all = 0
cnt_f_3_all = 0
cnt_f_4_all = 0
cnt_f_n0_1_liq = 0
cnt_f_n0_2_liq = 0
cnt_f_n0_3_liq = 0
cnt_f_n0_4_liq = 0
cnt_f_n0_1_all = 0
cnt_f_n0_2_all = 0
cnt_f_n0_3_all = 0
cnt_f_n0_4_all = 0
cnt_f_n1_1_liq = 0
cnt_f_n1_2_liq = 0
cnt_f_n1_3_liq = 0
cnt_f_n1_4_liq = 0
cnt_f_n1_1_all = 0
cnt_f_n1_2_all = 0
cnt_f_n1_3_all = 0
cnt_f_n1_4_all = 0
cnt_f_n2_1_liq = 0
cnt_f_n2_2_liq = 0
cnt_f_n2_3_liq = 0
cnt_f_n2_4_liq = 0
cnt_f_n2_1_all = 0
cnt_f_n2_2_all = 0
cnt_f_n2_3_all = 0
cnt_f_n2_4_all = 0
cnt_f_n3_1_liq = 0
cnt_f_n3_2_liq = 0
cnt_f_n3_3_liq = 0
cnt_f_n3_4_liq = 0
cnt_f_n3_1_all = 0
cnt_f_n3_2_all = 0
cnt_f_n3_3_all = 0
cnt_f_n3_4_all = 0
End Sub