My problem is the as follows:
I have 3 columns and 20 rows, that contains numbers.
There is a line with numbers between 1 to 20 in order crescente, the other cells contains bigger numbers then 100 or whatever.
My homework is that I have to write a VBA code which fill color the cells that contains the line. This way i going to have a "colorful snake" from the cells that contains the numbers between 1 to 20.
Of course, the starting number cell is "A1"
the ending cell can be anywhere in the area "A1:C20"
the substance is the colored cells must have follow the numbers in order cresence!
Sub MeykEhYewowSnakhey()
Dim r, c
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets(1)
For r = 1 To ws.UsedRange.Rows.Count
For c = 1 To ws.UsedRange.Columns.Count
If ws.Cells(r, c).Value < 100 Then
ws.Cells(r, c).Interior.ColorIndex = 6
End If
Next
Next
End Sub
Try that.
There is probably a much more efficient way to solve this but this is my solution.
Sub Snake()
Dim wbk As Workbook
Dim ws As Worksheet
Dim mySnake As Integer, x As Integer, y As Integer
Set wbk = Workbooks("Book1.xlsm")
Set ws = wbk.Worksheets("Sheet1")
x = 1
y = 1
With ws
For mySnake = 1 To 20
If .Cells(x, y) = mySnake Then
.Cells(x, y).Interior.Color = vbYellow
'Check cell below
If .Cells(x + 1, y) = mySnake + 1 Then
x = x + 1
'Check cell to right
ElseIf .Cells(x, y + 1) = mySnake + 1 Then
y = y + 1
'Check cells to left if y <> 1
ElseIf y <> 1 Then
If .Cells(x, y - 1) = mySnake + 1 Then
y = y - 1
End If
'Check cells above if x <> 1
ElseIf x <> 1 Then
If .Cells(x - 1, y) = mySnake + 1 Then
x = x - 1
End If
End If
End If
Next mySnake
End With
End Sub
Related
New to VBA if someone could help me what im doing wrong here.
Trying to run a loop such that it looks for a specific text, starts the loop then stops at a specific point.
The loops is such that I want it to copy some values below in my sheet hence a is 55.
Im facing the error Block IF without End If
Here is the code:
Private Sub CommandButton3_Click()
For y = 1 To 15 Step 5
Dim x As Double
Dim a As Double
x = 1
a = 55
If Cells(x, y).Value = "Text1" Then
Do Until Cells(x, y).Value = "Text2"
Cells(a, y) = Cells(x, y).Value
Cells(a, y + 1) = Cells(x, y + 1)
x = x + 1
a = a + 1
Loop
End Sub
Indenting is the way forward, you have a for statement with no next and an if with no End If:
Private Sub CommandButton3_Click()
For y = 1 To 15 Step 5
Dim x As Double
Dim a As Double
x = 1
a = 55
If Cells(x, y).Value = "Text1" Then
Do Until Cells(x, y).Value = "Text2"
Cells(a, y) = Cells(x, y).Value
Cells(a, y + 1) = Cells(x, y + 1)
x = x + 1
a = a + 1
Loop
End If
Next y
end sub
Besides the issues I mentioned in the comments to your post, if I understood you correctly, you want to loop on cells at Column A, find the first "Text1", then copy all the cells to row 55 and below, until you find "Text2". If that's the case, try the code below :
Private Sub CommandButton3_Click()
Dim x As Long, y As Long
Dim a As Long
Dim LastRow As Long
With Worksheets("Sheet1") '<-- modify "Sheet1" to your sheet's name
For y = 1 To 15 Step 5
x = 1 '<-- reset x and a (rows) inside the columns loop
a = 55 '<-- start pasting from row 55
LastRow = .Cells(.Rows.Count, y).End(xlUp).Row
While x <= LastRow '<-- loop until last row with data in Column y
If .Cells(x, y).Value Like "Text1" Then
Do Until .Cells(x, y).Value = "Text2"
.Cells(a, y).Value = .Cells(x, y).Value
.Cells(a, y + 1).Value = .Cells(x, y + 1).Value
x = x + 1
a = a + 1
Loop
End If
x = x + 1
Wend
Next y
End With
End Sub
This is an error I've been trying to figure out for awhile now, my find method is not producing any results and I cannot figure out why.
The code is suppose to search InputSheet for a string, report the row number and start moving information over to Background based on that row number. Then the next .find will find the string in SummaryResults and start moving information from Background, reformat it a bit, and paste to SummaryResults.
My find method is not producing any results and leaves FindRow = Nothing even though the strings are present in the sheets and in the correct Ranges.
This error started occurring after running the macro with another Excel sheet open so maybe the ActiveWorkbook was incorrect, but I have not been able to get it to run since.
Some of the variables shown are from other sections of the code but when I hover over them in the debug mode they are showing what they're suppose to.
Option Explicit
Sub CAESARCONVERSION()
Dim InputSheet As Worksheet, SummaryResults As Worksheet, Background As Worksheet
Dim i As Integer
Dim j As Integer
Dim x As Integer
Dim y As Integer
Dim h As Integer
Dim v As Integer
Dim c As Integer
Dim z As Integer
Dim myBook As Workbook
Set myBook = Excel.ThisWorkbook
Set InputSheet = myBook.Sheets("Input Sheet")
Set SummaryResults = myBook.Sheets("Summary Results")
Set Background = myBook.Sheets("Background")
Dim NodeList As Integer
Dim TotalCases As Integer
Dim sMyString As String
Dim Nodes As Variant
Dim FindRow As Range
Dim intValueToFind As String
Dim FindRowNumber As Long
Dim SecondRowNumber As Long
'Clear the last run of macro
Background.Range("A2:A1000").Cells.Clear
Background.Range("C2:I10000").Cells.Clear
SummaryResults.Cells.Clear
'Code that will count the total number of load cases
TotalCases = 0
h = 2
Dim text As String
For v = 12 To 100
If InputSheet.Cells(v, 2).Value <> "" Then
text = LTrim(InputSheet.Cells(v, 2).Value)
Background.Cells(h, 3).Value = text
h = h + 1
TotalCases = TotalCases + 1
Else
GoTo NodeCounter
End If
Next v
NodeCounter:
y = TotalCases - 1
x = 0
Dim LoadCaseList() As Variant
ReDim LoadCaseList(y)
LoadCaseList:
For x = 0 To y
LoadCaseList(x) = Background.Cells(2 + x, 3).text
Next x
j = 2
For i = 17 + TotalCases To 20000 'Need to define how far for the program to search, we may exceed 20000 at some point
If InputSheet.Cells(i, 2).Value <> "" Then
Background.Cells(j, 1).Value = InputSheet.Cells(i, 2).Value
j = j + 1
End If
Next i
With Background
NodeList = Background.Cells(2, 2).Value
Background.Range("AA1:XX" & NodeList + 1).Cells.Clear
End With
ReDim Nodes(NodeList - 1)
v = 0
j = 2
For i = 0 To NodeList - 1
Nodes(i) = Background.Cells(j, 1).Value
j = j + 1
Next i
Headers:
Dim LoadCaseHeader() As String
Dim TypHeader()
TypHeader = Array("Node", "L", "Direction", "Magnitude")
Dim LoadDirections()
LoadDirections = Array("X", "Y", "Z", "MX", "MY", "MZ")
x = 0
z = 0
For x = 0 To NodeList - 1
For z = 0 To TotalCases - 1
SummaryResults.Range(("B" & 2 + (NodeList * 6 + 2) * z) & ":" & "E" & 2 + (NodeList * 6 + 2) * z) = TypHeader()
SummaryResults.Range("A" & 2 + (NodeList * 6 + 2) * z) = Background.Range("C" & 2 + z)
Next z
Next x
'Search rows for the first instance of this value.
LoadCases:
'Code that copies information from the InputSheet to the SummaryResults
Dim LoadCases() As Long
ReDim LoadCases(NodeList, 6)
FindRowNumber = 0
SecondRowNumber = 0
For c = 0 To y
intValueToFind = LoadCaseList(c)
For i = 7 To 31 + TotalCases
With InputSheet
If Trim(Cells(i, 3).Value) = intValueToFind Then
MsgBox ("Found")
Set FindRow = InputSheet.Range("C:C").Find(What:=intValueToFind, LookIn:=xlValues)
FindRowNumber = FindRow.Row
End If
End With
Next i
'MsgBox FindRowNumber
With InputSheet
For i = 0 To NodeList - 1
x = 4
For j = 0 To 5
LoadCases(i, j) = InputSheet.Cells(FindRowNumber + (TotalCases + 3) * i, x)
x = x + 1
Next j
Next i
End With
Background.Range("AC2:AH" & NodeList + 1).Offset(0, c * 7) = LoadCases
For i = 1 To NodeList * 6 * TotalCases
With SummaryResults
If Trim(Cells(i, 5).Value) = intValueToFind Then
Set FindRow = SummaryResults.Range("A:A").Find(What:=intValueToFind, LookIn:=xlValues)
SecondRowNumber = FindRow.Row
GoTo Step2
End If
End With
Next i
Step2:
With SummaryResults
For x = 0 To NodeList - 1
For j = 0 To 5
SummaryResults.Cells(SecondRowNumber + 1 + j + 6 * x, 5) = Background.Cells(x + 2, 29 + j)
SummaryResults.Cells(SecondRowNumber + 1 + j + 6 * x, 3) = TypHeader(1)
SummaryResults.Cells(SecondRowNumber + 1 + j + 6 * x, 4) = LoadDirections(j)
SummaryResults.Cells(SecondRowNumber + 1 + j + 6 * x, 2) = Nodes(x)
Next j
Next x
End With
Next c
End Sub
Any help would be appreciated. EDIT: Uploaded the entire code. Additional information, the code works when not tabbed into excel but will fail when tabbed in a ran again.
The issue seems to be that the LoadCaseList() array is never getting populated. This is your Find statement:
Set FindRow = InputSheet.Range("C:C").Find(What:=intValueToFind, LookIn:=xlValues)
intValueToFind is set by this statement:
intValueToFind = LoadCaseList(c)
But the LoadCaseList() array is populated by the following code which is a label that is never called by a GoTo statement (as far as I can tell):
LoadCaseList:
For x = 0 To y
LoadCaseList(x) = Background.Cells(2 + x, 3).text
Next x
So because the LoadCaseList label statement is never being called by a GoTo statement, the LoadCaseList() array is never being populated so intValueToFind has no value and therefore the Find method has no value to search for (except for maybe the empty string).
I have a matrix in an Excel sheet. In the first column are names of computers and in the other rows, I have users who are using it. For each computer there could be one associated user or two users and so on.
I wish to create a matrix of computers in the column and the all the users in the row and have VBA code to search the sheet, and if the user uses that computer, the output should be yes, else no.
Main Sheet
Computer A Dev Priya Rakesh Joseph
Computer B Rakesh Joseph
Computer C John Nisha Dev
Output Sheet
Computers Dev Priya Rakesh Joseph John Nisha
Computer A Y Y Y Y N N
Computer B N N Y Y N N
Computer C Y N N N Y Y
Rename sheet to 'Main' and copy data to it start from range A1.
Beware blank cell because I check end of row and column by check cell is "".
Rename other sheet to 'Output'.
Copy my code then run.
Note: Output sheet will clear all the time you run this macro.
Sub createMatrix()
Dim i As Long
Dim j As Long
Dim k As Long
Dim rngFind As Range
' Clear all contents in sheets output
Sheets("Output").Activate
Sheets("Output").Cells.ClearContents
i = 0
j = 1
k = 1
Do While Sheets("Main").Range("A1").Offset(i).Value <> ""
' Insert computer name to output sheet
Sheets("Output").Range("A2").Offset(i).Value = Sheets("Main").Range("A1").Offset(i).Value
Do While Sheets("Main").Range("A1").Offset(i, j).Value <> ""
' Check name is exists?
Set rngFind = Rows("1:1").Find(what:=Sheets("Main").Range("A1").Offset(i, j).Value, LookAt:=xlWhole)
If rngFind Is Nothing Then
' If not exists paste new name
Sheets("Output").Range("A1").Offset(0, k).Value = Sheets("Main").Range("A1").Offset(i, j).Value
' Mark use as 'Y'
Sheets("Output").Range("A1").Offset(i + 1, k).Value = "Y"
k = k + 1
Else
' Mark use as 'Y'
rngFind.Offset(i + 1).Value = "Y"
End If
j = j + 1
Loop
i = i + 1
j = 1
Loop
' This loop for Mark 'N'
i = 0
j = 1
Do While Sheets("Output").Range("A2").Offset(i).Value <> ""
Do While Sheets("Output").Range("A1").Offset(0, j).Value <> ""
' If found blank cell Mark 'N'
If Sheets("Output").Range("A2").Offset(i, j).Value = "" Then
Sheets("Output").Range("A2").Offset(i, j).Value = "N"
End If
j = j + 1
Loop
i = i + 1
j = 1
Loop
End Sub
Sample main sheet and output
This version creates a new sheet
Option Explicit
Public Sub TheMatrixReloaded() 'There is no spoon
Const FR As Long = 1: Const FC As Long = 2
Dim ws1 As Worksheet, ws2 As Worksheet, lr As Long, ur As Range
Dim ud As Object, cel As Range, i As Long
Set ws1 = ThisWorkbook.Worksheets("Sheet1")
With ws1.UsedRange
lr = ws1.Cells(.Rows.Count + .Row + 1, FC - 1).End(xlUp).Row
Set ur = ws1.Range(ws1.Cells(FR + 1, FC), ws1.Cells(lr, .Columns.Count + .Column - 1))
End With
Set ud = CreateObject("Scripting.Dictionary")
Application.ScreenUpdating = False
Set ws2 = ThisWorkbook.Worksheets.Add(After:=ws1)
ws1.Range(ws1.Cells(FR, FC - 1), ws1.Cells(lr, FC - 1)).Copy ws2.Cells(FR, FC - 1)
For Each cel In ur
With cel
If Len(.Value2) > 0 Then
If Not ud.Exists(.Value2) Then
ud.Add .Value2, FC + i
ws2.Cells(FR, FC + i).Value2 = .Value2
ws2.Cells(.Row, FC + i).Value2 = "Y": i = i + 1
Else
ws2.Cells(.Row, ud(.Value2)).Value2 = "Y"
End If
End If
End With
Next
With ws2.UsedRange
Set ur = ws2.Range(ws2.Cells(FR + 1, FC), ws2.Cells(.Rows.Count, .Columns.Count))
Set ur = ur.SpecialCells(xlCellTypeBlanks)
End With
ur.Value2 = "N": ur.Font.Color = RGB(177, 177, 177)
ws2.Columns(1).AutoFit: ws2.UsedRange.HorizontalAlignment = xlCenter
ws2.Rows(2).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrBelow
Application.ScreenUpdating = True
End Sub
Literally first time in two decades I've done this and that was even super basic (no pun intended). I have Sheet1 ("Main Page") that I am copying data from ("Control Sequences") based on data entered in Column B. I have it sort of working. The issue I will run into is when I copy over the first set of data, then want to bring in another set, the code runs for the whole sheet again and overwrites any tweaks I did previously. I want to be able to bring in a set of data to Sheet1, manually skip a couple of rows, type in another value in column B below that, re-run the code and append new data in. I'll try to come up with a simpler explanation if this doesn't make sense. Brain is fried right now after 5 hours of VBA absorption :P Here is the code I have so far in its entirety (It's sort of brute force so beware):
Sub test()
Dim i As Integer 'Main Page Sheet Row Number
Dim n As Integer 'Control Sequences Sheet Row Number
Dim x As Integer 'Main Page Current Row Number
Dim y As Integer 'Column Number
Dim CSrow As Integer 'Current Row
Dim NextCS As Integer 'Next Control Sequence
Dim NextCSrow As Integer 'Row To Stop At
Dim ws1 As Worksheet 'Var
Dim ws2 As Worksheet 'Var
Set ws1 = Worksheets("Main Page")
Set ws2 = Worksheets("Control Sequences")
y = 2
'Cycles through the codes in sheet 1
For i = 2 To ws1.Cells(ws1.Rows.Count, y).End(xlUp).row Step 1
For n = 2 To ws2.Cells(ws2.Rows.Count, y).End(xlUp).row Step 1
If ws1.Cells(i, y).Value = ws2.Cells(n, y).Value Then
x = i
CSrow = ws2.Cells(n, y).row
NextCS = ws1.Cells(i, y).Value + 1
NextCSrow = Application.WorksheetFunction.Match(NextCS, ws2.Range("B1:B200"), 0)
NextCSrow = NextCSrow - 1
For CSrow = CSrow To NextCSrow
y = y + 1
For y = 3 To 7
ws1.Cells(x, y).Value = ws2.Cells(CSrow, y).Value
Next y
' ws1.Cells(x, 8).Formula = ws2.Cells(CSrow, 8).Formula
y = y + 1
ws1.Cells(x, y).Value = ws2.Cells(CSrow, y).Value
y = y + 2
ws1.Cells(x, y).Value = ws2.Cells(CSrow, y).Value
x = x + 1
y = 2
Next CSrow
End If
Next n
Next i
End Sub
Thanks to anyone for your help and input.
EDIT 13 FEB 2014
As mentioned in the comment to the Answer below, I took out the .End(xlUp) piece and it worked. I've also changed the body of the writing loop to this:
For CSrow = CSrow To NextCSrow
' y = y + 1
' For y = 3 To 7
' ws1.Cells(x, y).Value = ws2.Cells(CSrow, y).Value
' Next y
' ws1.Cells(x, 8).Formula = ws2.Cells(CSrow, 8).Formula
' y = y + 1
' ws1.Cells(x, y).Value = ws2.Cells(CSrow, y).Value
' y = y + 2
' ws1.Cells(x, y).Value = ws2.Cells(CSrow, y).Value
' x = x + 1
' y = 2
ws2.Rows(CSrow).Copy Destination:=ws1.Cells(x, 1)
x = x + 1
Next CSrow`
I've got the formatting and the formula to copy over without keeping the original reference :D On to part IV... Testing ALL of the Variables and not just 1 ;) I will continue to update this thread with ... well ... updates.
EDIT 20 FEB 2014
Here's the complete code as it stands now:
Sub test()
Dim i As Long 'Main Page Sheet Row Number
Dim j As Long 'Placeholder
Dim n As Long 'Control Sequences Sheet Row Number
Dim x As Long 'Main Page Current Row Number
Dim y As Long 'Column Number
Dim z As Long
Dim a As Long
Dim CSrow As Long 'Current Row
Dim NextCS As Long 'Next Control Sequence
Dim NextCSrow As Long 'Row To Stop At
Dim ws1 As Worksheet 'Var
Dim ws2 As Worksheet 'Var
Dim ws3 As Worksheet 'Var
Dim ws4 As Worksheet 'Var
' Set ws1 = Worksheets("Main Page")
Set ws1 = ActiveSheet
Set ws2 = Worksheets("Control Sequences")
Set ws3 = Worksheets("Cost 1")
Set ws4 = Worksheets("Cost 2")
If ws1.Name = ws2.Name Or ws1.Name = ws3.Name Or ws1.Name = ws4.Name Then
End
End If
y = 2
z = 10
a = ws1.Cells(ws1.Rows.Count, z).End(xlUp).row + 2
If IsEmpty(ws1.Cells(a, y).Value) Then End
'Cycles through the codes in sheet 1
j = ws1.Cells(ws1.Rows.Count, y).End(xlUp).row
i = ws1.Cells(j, y).row
For i = i To j Step 1
For n = 2 To ws2.Cells(ws2.Rows.Count, y).End(xlUp).row Step 1
If ws1.Cells(i, y).Value = ws2.Cells(n, y).Value Then
x = i
CSrow = ws2.Cells(n, y).row
NextCS = ws1.Cells(i, y).Value + 1
NextCSrow = Application.WorksheetFunction.Match(NextCS, ws2.Range("B1:B100"), 0)
NextCSrow = NextCSrow - 1
For CSrow = CSrow To NextCSrow
' y = y + 1
' For y = 3 To 7
' ws1.Cells(x, y).Value = ws2.Cells(CSrow, y).Value
' Next y
' ws1.Cells(x, 8).Formula = ws2.Cells(CSrow, 8).Formula
' y = y + 1
' ws1.Cells(x, y).Value = ws2.Cells(CSrow, y).Value
' y = y + 2
' ws1.Cells(x, y).Value = ws2.Cells(CSrow, y).Value
' x = x + 1
' y = 2
ws2.Rows(CSrow).Copy Destination:=ws1.Cells(x, 1)
x = x + 1
Next CSrow
End If
Next n
Next i
End Sub
I added a check that if the user was on any of the "Template" sheets, the code would just stop. It's a bit brute force, but it gets the job done and it's the only code I have. Maybe if I continue to do this, I'll try to get more "streamlined". :D Thanks to everyone for their input and help.
I think I have it. Your problem is in the first line of your loop:
For i = 2 To ws1.Cells(ws1.Rows.Count, y).End(xlUp).row Step 1
Try setting i dynamically before the loop begins. DIM another variable j for this, then replace the above line with the following:
j = ws1.Cells(ws1.Rows.Count, y).End(xlUp).row
i = ws1.Cells(j, y).End(xlUp).row
For i = i to j Step 1
While you're at it, change your row integers to long since there are more rows in a worksheet than integers can handle.
I'm working on a project where I have sales data broken down into quarters. What I need to do is in front of each column insert the three months that belong in that quarter. I started with a select case statement, but then realized that probably isn't the best way to do it. What I want to do is have it be a variable range (there can be anything from 1-10 years pasted in) so I set it up to search InStr for "Q1", "Q2" and then insert the rows and proper month titles. I haven't inserted month titles yet, because I want to get the rows inserted first, but if you have a suggestion on how to do that without specifying cell values that'd also be awesome! it's also worth mentioning this data insertion starts on column U and will every time. Thanks for any help or suggestions!
Sub InsertMonths()
If cell.value = InStr(1, cell, "Q1", 1) Then
Dim y As String
y = InStr(1, cell, "Q1", 1)
If y = "" Then Exit Sub
Dim x As Long
For x = Cells(Columns.Count, 1).End(xlUp).Column To 1 Step -1
If Cells(x, 18).value = y Then
Columns(x + 3).Resize(1).Insert
End If
Next x
Else cell.value = InStr(1, cell, "Q2", 1) Then
Dim y As String
y = InStr(1, cell, "Q2", 1)
If y = "" Then Exit Sub
Dim x As Long
For x = Cells(Columns.Count, 1).End(xlUp).Column To 1 Step -1
If Cells(x, 18).value = y Then
Columns(x + 3).Resize(1).Insert
End If
Next x
Else InStr(1, cell, "Q3", 1) then
Dim y As String
y = InStr(1, cell, "Q3", 1)
If y = "" Then Exit Sub
Dim x As Long
For x = Cells(Columns.Count, 1).End(xlUp).Column To 1 Step -1
If Cells(x, 18).value = y Then
Columns(x + 3).Resize(1).Insert
End If
Next x
Else InStr(1, cell, "Q4", 1) then
Dim y As String
y = InStr(1, cell, "Q4", 1)
If y = "" Then Exit Sub
Dim x As Long
For x = Cells(Columns.Count, 1).End(xlUp).Column To 1 Step -1
If Cells(x, 18).value = y Then
Columns(x + 3).Resize(1).Insert
End If
Next x
End If
End Sub
Without coming into too much detail in the exact situation, here you have a couple of loops doing the same than your set of conditions. It is prepared to deal with as many cells as required (letters and ints).
Sub InsertMonths()
Dim startInt, endInt, totLetters, lettersCount, curInt As Integer
Dim allLetters(10), curLetter, curCell As String
totLetters = 1
allLetters(1) = "Q"
startInt = 1
endInt = 4
lettersCount = 0
Do
lettersCount = lettersCount + 1
curLetter = allLetters(lettersCount)
curInt = startInt - 1
Do
curInt = curInt + 1
curCell = curLetter & CStr(curInt)
If cell.Value = InStr(1, cell, curCell, 1) Then
Dim y As String
y = InStr(1, cell, curCell, 1)
If y = "" Then Exit Sub
Dim x As Long
For x = Cells(Columns.Count, 1).End(xlUp).Column To 1 Step -1
If Cells(x, 18).Value = y Then
Columns(x + 3).Resize(1).Insert
End If
Next x
End If
Loop While (curInt < endInt)
Loop While (curLetter < totLetters)
End Sub
In your code, where you are setting the value in the cell to hold the month, put the following formula instead of the value
Cells(x, y).value = "=(MID($D2,2,1) - 1) * 3 + 1"
Second column would be
Cells(x, y).value = "=(MID($D2,2,1) - 1) * 3 + 2"
And third would be
Cells(x, y).value = "=(MID($D2,2,1) - 1) * 3 + 3"
In all of the cases above, the $D2 should reference the cell you found to contain the "Q#". The formulas are basically taking the numerical part of the quarter and calculating the 1st, 2nd and 3rd months of the quarter.
Also note that this gives you the month number. If you want the name, you should be able to figure that out.