Provided all the conditions in the code below is met, can anyone provide me with an idea as to why ResultG populates in the excel worksheet but ResultGi does not. I have tried re-arranging and linking various parts of both codes together but to no avail.
Result6 = (23)
Result6i = (24)
If Result1 = 19 And ((Result2ai >= 7) And (Result2ai <= 14)) Then
Result6 = (23)
Result6i = (24)
If Result1a = 15 And ((Result3a >= 6) And (Result3a <= 10)) Then
Result4 = 19
Result5i = Result6 - Result4
ResultG = Result5i - Range("G2").Value
Range("W2").Value = ("ResultG")
Range("X2").Value = (" Can Use: [ " & ResultG & " ]")
Range("Y2").Value = ("2 Nxt will not be " & ResultG)
Range("Z2").Value = (" 19|15|5i ")
Result5iii = Result6i - Result4
ResultGi = Result5iii - Range("G2").Value
Range("W3").Value = ("ResultGi")
Range("X3").Value = (" Can Use: [ " & ResultGi & " ]")
Range("Y3").Value = ("2 Nxt will not be " & ResultGi)
Range("Z3").Value = (" 19|15|5ii ")
End If
End If
End Sub
Related
I keep getting the compile error resposne Expected Sub, Function or Property, when trying to run below VBA code. The problem is with the called sub procedure. Any insight as to why will be appreciated.
Result5iii = Result6i - Result4
ResultGi = Result5iii - Range("G2").Value
Range("W3").Value = ("ResultGi")
Range("X3").Value = (" Can Use: [ " & ResultGi & " ]")
Range("Y3").Value = ("2 Nxt will not be " & ResultGi)
Range("Z3").Value = (" 19|15|5ii ")
'Minus1Rule_OriginalsG'
If Result5iii = 5 And Range("G2").Value = 1 And ResultGi = 4. Then
Call Minus1Rule_5OriginalsG
The called Procedure is;
Public Sub Minus1Rule_5OriginalsG()
Dim ResultG As Double, Result5i As Double, Result1 As Double, Result1a As Double
'1. -1 Rule'
'For Originals'
Range("W2").Value = (" 0, 5 [ " & ResultG & " ]")
Range("X2").Value = (" Can Use: 0, 5 [ " & ResultG & " ]")
Range("Y2").Value = ("2 Nxt will not be " & "0, 5" & "Reason: -1 Rule For Originals")
Range("Z2").Value = (Result1 & "|" & Result1a & " 5 - 1" & "|" & "5i ")
End Sub
I am trying to determine if any one of the strings inside any one of the array items in a VBA dictionary equal a string of 4 spaces.
If _
Not CStr(info.Items(1, 4)) = " " Or _
Not CStr(info.Items(1, 5)) = " " Or _
Not CStr(info.Items(1, 6)) = " " Or _
Not CStr(info.Items(2, 4)) = " " Or _
Not CStr(info.Items(2, 5)) = " " Or _
Not CStr(info.Items(2, 6)) = " " Or _
Not CStr(info.Items(3, 4)) = " " Or _
Not CStr(info.Items(3, 5)) = " " Or _
Not CStr(info.Items(3, 6)) = " " Or _
Not CStr(info.Items(4, 4)) = " " Or _
Not CStr(info.Items(4, 5)) = " " Or _
Not CStr(info.Items(4, 6)) = " " Then
I keep getting a Subscript out of range error. I've tried
...info.Items(1)(4)... as well with the same error.
I know each array item has 6 elements in it, and I know there are 4 keys in the dictionary. How do I access elements of each key's item if the item is an array?
Dim RQItems As Dictionary
Dim RPItems As Dictionary
Dim IMPItems As Dictionary
Dim EMItems As Dictionary
Dim BOOTItems As Dictionary
Dim RQ1(6) As String
Dim RQ2(6) As String
Dim RQ3(6) As String
Dim RQ4(6) As String
Set RQItems = New Dictionary
RQ1(1) = "PSA "
RQ1(2) = "Prlm"
RQ1(3) = "Info"
RQ1(4) = " "
RQ1(5) = " "
RQ1(6) = " "
RQ2(1) = "Mary"
RQ2(2) = "Clnt"
RQ2(3) = "Escr"
RQ2(4) = "Bank"
RQ2(5) = " SS "
RQ2(6) = " "
RQ3(1) = "Inst"
RQ3(2) = "Wire"
RQ3(3) = " "
RQ3(4) = " "
RQ3(5) = " "
RQ3(6) = " "
RQ4(1) = "Acct"
RQ4(2) = "Fee "
RQ4(3) = " "
RQ4(4) = " "
RQ4(5) = " "
RQ4(6) = " "
RQItems("OPEN") = RQ1
RQItems("DOCS") = RQ2
RQItems("$$$$") = RQ3
RQItems("FILE") = RQ4
I pass these into a function like myFn(info As Dictionary)
You can access arrays stored in a dictionary like this:
Sub Test()
Dim dict As New Dictionary, arr(1 To 4), k, arr2, v
arr(1) = "One"
arr(2) = "Two"
arr(3) = "Three"
arr(4) = "four"
dict.Add "Test", arr
'access a single item
Debug.Print dict("Test")(1) '>> One
'loop over all contained arrays
For Each k In dict.Keys
arr2 = dict(k)
Debug.Print arr2(3) 'access a single element
'or loop through all elements in the array
For Each v In arr2
Debug.Print k, v
Next v
Next k
End Sub
Compiler Error: End With Has No With. I know that this is wrong, and there is something in my code in where I am not calling it correctly that is making it mess up but I cannot find it. I'm just trying to grab information off of my sheet1 so that I can use it later on.
With ThisWorkbook.Sheets("Sheet1")
While (Counter <= 300)
Pcounter = .Cells(ACBoxCounter, 2)
If (Pcounter <> "") Then
ACounter = ACounter + 1
End If
ACBCounter = ACBCounter + 30
Wend
While (OverallACounter < ACounter)
Set objStream = CreateObject("ADODB.Stream")
objStream.Charset = "iso-8859-1"
objStream.Open
ExampleString = .Cells(Row2Counter + 22, 3)
ChooseM = Split(ExampleString, "-")(1)
If (ChooseM = "8")
M = "II"
P = 97
Label = .Cells(Row2Counter, 2)
ElseIf (ChooseM = "13") Then
Model = "A II"
P = 10
Label = "A6_" & .Cells(Row2Counter, 2)
ElseIf (ChooseM = "19") Then
M = "AC1I"
P = 56
Label = "A9_" & .Cells(Row2Counter, 2)
End If
OverallD = 0
Overall= 0
OverallB = 0
ChooseBoxType = Split(ExampleString, "-")(2)
If ((StrComp(ChooseB, "1") = 0) Or (StrComp(ChooseB, "1M") = 0)) Then
BoxInputT= "1 Phase"
ElseIf ((StrComp(ChooseB, "2") = 0) Or (StrComp(ChooseB, "2M") = 0)) Then
BoxInput= "2"
ElseIf ((StrComp(ChooseB ,"3") = 0) Or (StrComp(ChooseBo, "3M") = 0)) Then
BoxInput= "3"
End If
objStream.WriteText (" <" & .Cells(Row2Counter, 2).Text & ">" & vbLf)
Wend
End With
Compiler Error: End With Has No With
I dispose a macro tool that I used for the distance calculation between different points in Excel. However since Google API started billing the service it is out of use.
I have created a google API key but for the moment I am stuck at this step, it says that the method open of the object 'IXMLHTTPRequest' has failed
https://i.stack.imgur.com/ODXT4.png
https://i.stack.imgur.com/6ZDcG.png
Could you please help me on that?
Here is the entire script of my macro:
Sub Calculer(Départ As String, Arrivée As String, Distance As String, Temps As Double)
Dim surl As String
Dim oXH As Object
Dim bodytxt As String
'Utilisation de l'API Google
Distance = ""
Temps = 0
Départ = Replace(Départ, " ", "+")
Départ = SupprimerAccents(Départ)
Arrivée = Replace(Arrivée, " ", "+")
Arrivée = SupprimerAccents(Arrivée)
surl = "http://maps.googleapis.com/maps/api/distancematrix/xml?origins=" & _
Départ & "&destinations=" & Arrivée & _
"&mode=driving&sensor=false&units=metric"
Set oXH = CreateObject("msxml2.xmlhttp")
With oXH
.Open "get", surl, False
.send
bodytxt = .responseText
End With
bodytxt = Right(bodytxt, Len(bodytxt) - InStr(1, bodytxt, "<text>") - 5)
If InStr(1, bodytxt, "</text>") <> 0 Then Temps_Texte = Left(bodytxt, InStr(1, bodytxt, "</text>") - 1)
If Temps_Texte <> "" Then
Temps_Texte = Replace(Temps_Texte, " weeks", "w")
Temps_Texte = Replace(Temps_Texte, " week", "w")
Temps_Texte = Replace(Temps_Texte, " day", "j")
Temps_Texte = Replace(Temps_Texte, " hours", "h")
Temps_Texte = Replace(Temps_Texte, " hour", "h")
Temps_Texte = Replace(Temps_Texte, " mins", "m")
Temps_Texte = Replace(Temps_Texte, " min", "m")
Temps_Texte = Replace(Temps_Texte, " seconds", "s")
Temps_Texte = Replace(Temps_Texte, " second", "s")
Heure = Split(Temps_Texte, " ")
j = 0
On Error GoTo fin
If Right(Heure(j), 1) = "w" Then Temps = Temps + Val(Heure(j)) * 7: j = j + 1
If Right(Heure(j), 1) = "d" Then Temps = Temps + Val(Heure(j)): j = j + 1
If Right(Heure(j), 1) = "h" Then Temps = Temps + Val(Heure(j)) / 24: j = j + 1
If Right(Heure(j), 1) = "m" Then Temps = Temps + Val(Heure(j)) / 24 / 60: j = j + 1
If Right(Heure(j), 1) = "s" Then Temps = Temps + Val(Heure(j)) / 24 / 60 / 60: j = j + 1
fin:
On Error GoTo 0
End If
bodytxt = Right(bodytxt, Len(bodytxt) - InStr(1, bodytxt, "<text>") - 5)
If InStr(1, bodytxt, "</text>") <> 0 Then Distance = Left(bodytxt, InStr(1, bodytxt, "</text>") - 1)
If Distance = "" Then Distance = "Aucun résultat"
Distance = Replace(Distance, " km", "")
Distance = Replace(Distance, ",", "")
Set oXH = Nothing
End Sub
Function SupprimerAccents(ByVal sChaine As String) As String
'Fonction récupérée ici : http://www.developpez.net/forums/d1089902/logiciels/microsoft-office/excel/macros-vba-excel/suppression-accents-chaines-caracteres/
Dim sTmp As String, i As Long, p As Long
Const sCarAccent As String = "ÁÂÃÄÅÇÈÉÊËÌÍÎÏÑÒÓÔÕÖÙÚÛÜÝàáâãäåçèéêëìíîïñòóôõöùúûüýÿ"
Const sCarSansAccent As String = "AAAAACEEEEIIIINOOOOOUUUUYaaaaaaceeeeiiiinooooouuuuyy"
sTmp = sChaine
For i = 1 To Len(sTmp)
p = InStr(sCarAccent, Mid(sTmp, i, 1))
If p > 0 Then Mid$(sTmp, i, 1) = Mid$(sCarSansAccent, p, 1)
Next i
SupprimerAccents = sTmp
End Function
In this line:
surl = "http://maps.googleapis.com/maps/api/distancematrix/xml?origins=" & _
Départ & "&destinations=" & Arrivée & _
"&mode=driving&sensor=false&units=metric"
Add your key (and remove the &sensor=false):
surl = "http://maps.googleapis.com/maps/api/distancematrix/xml?origins=" & _
Départ & "&destinations=" & Arrivée & _
"&mode=driving&units=metric&key=MY_API_KEY"
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