Using Month function in VBA - vba

I have two sheets, sheet1 is the report, and sheet2 is the result. In the result sheet I have in column A the months represented as "Jan", "Feb", etc and so on. In my report sheet I have the months represented in number.
My requirement is , to check the column W of report sheet is same as Column A of the result sheet. If they are same, then I have to print the count result in result sheet.
I have the below code to return the month
Sub month()
Dim ws As Worksheet
Dim i As Long
Dim totalrows As Long
Set ws = Sheets("Report")
totalrows = ws.Cells(Rows.count, "A").End(xlUp).Row
MsgBox (totalrows & " Check")
For i = 5 To totalrows
' get the current week in column 23
Cells(i, 23).Value = Month(Now)
Next
End Sub
the below code, checks for the current month in both the sheets and prints the count value . could someone help, how I can say the VBA that the Column W containing 9 is same as Column A containing September. ? The month entered in the column A is manual entry.
Sub result()
Dim i As Long, j As Long, cntR As Long, CntS As Long, cntT As Long, cntU As Long, sht As Worksheet
Set sht = Sheets("Result")
Sheets("Report").Select
For i = 2 To WorksheetFunction.CountA(sht.Columns(1))
' get the current week from column A of the sheet result
If sht.Range("A" & i) = Val(Month(Now)) Then Exit For
Next i
sht.Range("C" & i & ":" & "J" & i).ClearContents
For j = 5 To WorksheetFunction.CountA(Columns("W"))
' if column A and column W are same, then count 1, in column A, R; S, T, U
If sht.Range("A" & i) = Range("W" & j) Then
If Range("R" & j) = "1" Then cntR = cntR + 1
If Range("S" & j) = "1" Then CntS = CntS + 1
If Range("T" & j) = "1" Then cntT = cntT + 1
If Range("U" & j) = "1" Then cntU = cntU + 1
End If
Next j
' print the count values in the respective column
If cntR <> 0 Then sht.Range("C" & i) = cntR
If CntS <> 0 Then sht.Range("D" & i) = CntS
If cntT <> 0 Then sht.Range("E" & i) = cntT
If cntU <> 0 Then sht.Range("F" & i) = cntU
If cntR + CntS + cntT + cntU <> 0 Then
sht.Range("G" & i) = cntR / (cntR + CntS + cntT + cntU)
sht.Range("H" & i) = CntS / (cntR + CntS + cntT + cntU)
sht.Range("I" & i) = cntT / (cntR + CntS + cntT + cntU)
sht.Range("J" & i) = cntU / (cntR + CntS + cntT + cntU)
End If
End Sub

Related

How to copy from column to row not using PasteSpecial Transpose?

This loop to copies the values from one sheet's columns to another sheet's columns:
Dim ExposureDataInput As Worksheet
Dim ManualSimulation As Worksheet
Set EDI = Sheets("ExposureDataInput")
Set MS = Sheets("ManualSimulation")
Dim i As Integer
Dim n As Integer
For i = 2 To EDI.Range("B" & Rows.Count).End(xlUp).Row
If EDI.Range("B" & i).Value > 0 Then
n = MS.Range("A" & Rows.Count).End(xlUp).Row + 1
MS.Range("A" & n).Value = EDI.Cells(i, 1).Value
n = MS.Range("B" & Rows.Count).End(xlUp).Row + 1
MS.Range("B" & n).Value = EDI.Cells(i, 2).Value
n = MS.Range("C" & Rows.Count).End(xlUp).Row + 1
MS.Range("C" & n).Value = EDI.Cells(i, 4).Value
n = MS.Range("D" & Rows.Count).End(xlUp).Row + 1
MS.Range("D" & n).Value = EDI.Cells(i, 6).Value
n = MS.Range("E" & Rows.Count).End(xlUp).Row + 1
MS.Range("E" & n).Value = EDI.Cells(i, 8).Value
n = MS.Range("F" & Rows.Count).End(xlUp).Row + 1
MS.Range("F" & n).Value = EDI.Cells(i, 10).Value
n = MS.Range("G" & Rows.Count).End(xlUp).Row + 1
MS.Range("G" & n).Value = EDI.Cells(i, 12).Value
End If
Next i
I tried the same principal to get the col A:A from one sheet to a row in another sheet:
Dim ExposureDataInput As Worksheet
Dim HistoricalDataandExcessReturns As Worksheet
Set EDI = Sheets("ExposureDataInput")
Set HDaER = ThisWorkbook.Worksheets("HistoricalDataandExcessReturns")
Dim k As Integer
Dim y As Integer
For k = 2 To EDI.Range("B" & Rows.Count).End(xlUp).Row
If EDI.Range("B" & k).Value > 0 Then
y = HDaER.Range(Columns.Count & 1).End(xlToLeft).Column + 1
HDaER.Range(y & 1).Value = EDI.Cells(1, k).Value
y = HDaER.Range(Columns.Count & 2).End(xlToLeft).Column + 1
HDaER.Range(y & 2).Value = EDI.Cells(2, k).Value
End If
Next k
The i in the column to column works. When I try with k in a column to row it gives me
Run-time error '1004'.
How can I copy a column to a row?
I believe the issue lies with the way you are trying to get the last Column, please have a look at my answer below:
The first sub could be written as:
Dim ExposureDataInput As Worksheet
Dim ManualSimulation As Worksheet
Set EDI = Sheets("ExposureDataInput")
Set MS = Sheets("ManualSimulation")
Dim i As Long
Dim n As Long
For i = 2 To EDI.Range("B" & EDI.Rows.Count).End(xlUp).Row
If EDI.Range("B" & i).Value > 0 Then
n = MS.Cells(MS.Rows.Count, "A").End(xlUp).Row + 1
'get the next free row without data on Column A
MS.Range("A" & n).Value = EDI.Cells(i, 1).Value
MS.Range("B" & n).Value = EDI.Cells(i, 2).Value
MS.Range("C" & n).Value = EDI.Cells(i, 4).Value
MS.Range("D" & n).Value = EDI.Cells(i, 6).Value
MS.Range("E" & n).Value = EDI.Cells(i, 8).Value
MS.Range("F" & n).Value = EDI.Cells(i, 10).Value
MS.Range("G" & n).Value = EDI.Cells(i, 12).Value
End If
Next i
The second sub could be written as:
Dim ExposureDataInput As Worksheet
Dim HistoricalDataandExcessReturns As Worksheet
Set EDI = Sheets("ExposureDataInput")
Set HDaER = ThisWorkbook.Worksheets("HistoricalDataandExcessReturns")
Dim k As Long
Dim y As Long
For k = 1 To EDI.Cells(EDI.Rows.Count, "B").End(xlUp).Row
If EDI.Range("B" & k).Value > 0 Then
y = HDaER.Cells(1, HDaER.Columns.Count).End(xlToLeft).Column + 1
'count the number of column on row 1
HDaER.Cells(1, y).Value = EDI.Cells(k, 1).Value
y = HDaER.Cells(2, HDaER.Columns.Count).End(xlToLeft).Column + 1
'count the number of columns on row 2?
HDaER.Cells(2, y).Value = EDI.Cells(k, 2).Value
End If
Next k
Actually, the error you should be getting is 6 - Overflow.
Try this small piece of code:
Sub TestMe()
Dim a As Integer
a = Rows.Count
End Sub
You would get an overflow error, because the Integer is from -32768 to 32767 and the rows in Excel are more than 1 million. The columns are 16384, thus they enough for an integer.
Replace the Integer with Long and try again.

Counting the columns in sheet1 and pasting their result in a table in sheet 2

I have two sheets. sheet1 is Evaluation and sheet2 is the result sheet.
From the Evaluation sheet1, I would like to count the number of "OK" in Column S and T and count the number of "Invalid" in the column R.
These counted values are to be entered In the sheet2 result , in their corresponding columns.
I was working with this code and It worked completely fine.
But now, when I run the code, number of OK in the column S and T and number of Invalid in the column R are not counted.
Here is the Code I am trying to work with
Sub result()
Dim i As Integer
Dim j As Integer
Dim cnt As Integer
Dim cntU, CntS, cntT As Integer
Dim sht As Worksheet
Dim totalrows, n As Long
Set sht = Sheets("Result")
Sheets("Evaluation").Select
totalrows = Range("A5").End(xlDown).Row
n = Worksheets("FC_SCR Evaluation").Range("A5:A" & totalrows).Cells.SpecialCells(xlCellTypeConstants).count
For i = 2 To WorksheetFunction.count(sht.Columns(1))
cntT = 0
cntU = 0
CntS = 0
' get the current week of column A of result sheet
If sht.Range("A" & i) = Val(Format(Now, "WW")) Then Exit For
Next i
' if column A of result sheet and Column x of fc sheet are same, then count the mentioned parameters
For j = 5 To WorksheetFunction.CountA(Columns(23))
If sht.Range("A" & i) = Range("X" & j) And Range("T" & j) = "OK" Then cntT = cntT + 1
If sht.Range("A" & i) = Range("X" & j) And Range("S" & j) = "OK" Then cntU = cntU + 1
If sht.Range("A" & i) = Range("X" & j) And Range("R" & j) = "Invalid" Then CntS = CntS + 1
' print the counted value in corresponding column of result sheet
If cntT <> 0 Then sht.Range("D" & i) = cntT
If cntU <> 0 Then sht.Range("E" & i) = cntU
If CntS <> 0 Then sht.Range("C" & i) = CntS
If n <> 0 Then sht.Range("B" & i) = n
Next j
If cntT + cntU <> 0 Then
sht.Range("F" & i) = CntS / n
sht.Range("g" & i) = cntT / n
sht.Range("h" & i) = cntU / n
End If
End Sub

VBA nested looping with do until loop

I need a looping structure that checks a range of cells, then if the cell and a cell that is in the range equal each other then the font should turn red. My problem is that my do until loop won't get entered. This is what I have right now.
`
Dim finalrow As Long
finalrow = Worksheets("Redundancy").Cells(Worksheets("Redundancy").Rows.Count, "D").End(xlUp).Row
Dim z As Long
Dim w As Long
Dim r As Long
w = 2
r = 0
For z = 2 To finalrow
If Range("L" & z) = Range("L" & z + 1) & Range("J" & z) <> Range("J" & z + 1) Then
Do Until Range("L" & z) = Range("L" & z + 1) & Range("J" & z) <> Range("J" & z + 1)
If Cells(w, 4) = Cells(z + 1, 4 + r) Then
Cells(w, 1).Font.ColorIndex = 3
Cells(z + 1, 1).Font.ColorIndex = 3
If r = 4 Then
w = w + 1
End If
End If
r = r + 1
Loop
End If
Next z
`
I changed it to this, but it exits the loop all together right when it is about to enter the do while loop.
`
For z = 2 To finalrow
Do While (Range("L" & z) = Range("L" & z + 1) And Range("J" & z) <> Range("J" & z + 1))
If Cells(w, 4) = Cells(z + 1, 4 + r) Then
Cells(w, 1).Font.ColorIndex = 3
Cells(z + 1, 1).Font.ColorIndex = 3
If r = 4 Then
w = w + 1
End If
End If
r = r + 1
Loop
Next z
`
If you do this;
Range("L" & z) = Range("L" & z + 1) and Range("J" & z) <> Range("J" & z + 1)
you are comparing Range objects. What you instead want to do is to compare the values in those range objects. So use this instead;
Range("L" & z).value = Range("L" & z + 1).value and Range("J" & z).value <> Range("J" & z + 1).value
However when you use the cells(row,column) you don't have this problem.
I am curious though, was it not possible to use conditional formatting instead?
Use the 'and' operator instead of '&'.

Counting the value and pasting in another sheet based on the Cases

I have sheet "BW" and another sheet "Result". The sheet result has an Table with the weeknumber in column A.
I wanted to look for the weeknumber in sheet "result" and if the weeknumber is the same as the Weeknumber in my sheet "BW" in column "AX" then , I would like to count the number of "1" in the sheet "BW" in column "T" and "u".
But the problem is I have two cases for the counting of "1" in Column T and U
The column AA should not be equal to null.
The column Z should Contain "Ontime".
If these two case satisfies, then I would like to look into the column T and U and wount count for the 1 in the column.
I tried the code. But the case is not getting satisfied. Any lead would be helpful.
Sub results()
Dim i As Integer, j As Integer, cntT As Integer, cntu As Integer, ws As Worksheet
Set ws = Sheets("Result")
Sheets("BW").Select
For i = 2 To WorksheetFunction.CountA(ws.Columns(1))
cntT = 0
cntu = 0
If ws.Range("A" & i) = Val(Format(Now, "ww")) Then Exit For
Next i
For j = 5 To WorksheetFunction.CountA(Columns(50))
If ws.Range("AA" & i) <> "" And ws.Range("Z" & i) = "PSW Ontime" Then
ElseIf ws.Range("A" & i) = Range("AX" & j) And Range("T" & j) = 1 Then cntT = cntT + 1
ElseIf ws.Range("A" & i) = Range("AX" & j) And Range("U" & j) = 1 Then cntu = cntu + 1
Next j
If cntT <> 0 Then ws.Range("B" & i) = cntT
If cntu <> 0 Then ws.Range("C" & i) = cntu
If cntT + cntu <> 0 Then
ws.Range("D" & i) = cntT + cntu
ws.Range("E" & i) = cntT / (cntT + cntu)
ws.Range("F" & i) = cntu / (cntT + cntu)
End If
ws.Range("E" & i & ":F" & i).NumberFormat = "0%"
End If
End Sub
Could someone help me , how I can introduce this case in my code.

check for empty cel and then count the value in the column and paste it to another sheet

I am having two sht, sht1 as BW and sht2 as result.
I want to Count the number of 1's in column T and U of sht1, according to the week in column AX and print the Counted values in the result sheet, looking into the same week.
I took the advice of an expert in the Forum and completed till this.
I want an if condition, in such a way that, if the column AA is empty, then i should not Count the 1's in column T and U, it should be skipped.
I introduced this code of line in my existing code after j=2; and got an error
error Label not defined`,
If ws.Range("AA" & i) = "" Then
GoTo nextrow
could someone help, how i should execute this condition ?
here is my code;
Sub results()
Dim i As Integer, j As Integer, cntT As Integer, cntu As Integer, ws As Worksheet
Set ws = Sheets("Result")
Sheets("BW").Select
For i = 2 To WorksheetFunction.CountA(ws.Columns(1))
cntT = 0
cntu = 0
If ws.Range("A" & i) = Val(Format(Now, "ww")) Then Exit For
Next i
For j = 2 To WorksheetFunction.CountA(Columns(50))
If ws.Range("A" & i) = Range("AX" & j) And Range("T" & j) = 1 Then cntT = cntT + 1
If ws.Range("A" & i) = Range("AX" & j) And Range("U" & j) = 1 Then cntu = cntu + 1
Next j
If cntT <> 0 Then ws.Range("B" & i) = cntT
If cntu <> 0 Then ws.Range("C" & i) = cntu
If cntT + cntu <> 0 Then
ws.Range("D" & i) = cntT + cntu
ws.Range("E" & i) = cntT / (cntT + cntu)
ws.Range("F" & i) = cntu / (cntT + cntu)
End If
ws.Range("E" & i & ":F" & i).NumberFormat = "0%"
End Sub
The GoTo nextrow is looking for a line label titled nextrow. That's how the GoTo command is built and operates. For what you are trying to accomplish, try this instead:
If ws.Range("AA" & i) <> "" Then
If ws.Range("A" & i) = Range("AX" & j) And Range("T" & j) = 1 Then cntT = cntT + 1
If ws.Range("A" & i) = Range("AX" & j) And Range("U" & j) = 1 Then cntu = cntu + 1
End If
This way it says, if the column is NOT blank, then do stuff, otherwise go to next j
If you want to use the GoTo Command in the future you can use line numbers (like GoTo 0 which should take you back to the beginning of the code) or you can create a line label by placing nextrow: on an empty line. Then when you call GoTo nextrow it will go to that line, and proceed from there.