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

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.

Related

Excel VBA code adding blank rows

I am new to VBA and I have written the below code that is supposed to compare dates in two columns, and take which ever date is greater and display it on a Worksheet called PPDCI. If there is no dates, or dates are equal then it will display that record on another worksheet called "Error" and "REVIEW PPD DATA".
The program seems to work fine for the first two IF conditions for variables PPD_1_Date and PPD_2_Date that output data to the PPDCI worksheet, however the results on the Error tab are not what I am expecting. It seems to be including blank rows (rows that I believe are on the PPDCI tab with data), rows that only contain the cell with "REVIEW PPD DATA" (ID, Name information missing), and rows that just have data in columns A - C (sourced from the "Data" worksheets columns F - H).
I tried changing the code (commented out below) to include a condition for if the two date fields are empty then GoTo EmptyRange, just prior to iterating the Next i. This producted a runtime error though, even though it works on several other functions in my module
Function PPDdate()
Dim PPD_1_Date As Date
Dim PPD_2_Date As Date
Dim i As Long, j As Long, k As Long
j = Worksheets("PPDCI").Range("A" & Rows.Count).End(xlUp).Row + 1
k = Worksheets("Error").Range("A" & Rows.Count).End(xlUp).Row + 1
For i = 2 To lstrow
PPD_1_Date = Worksheets("Data").Range("AW" & i)
PPD_2_Date = Worksheets("Data").Range("BA" & i)
If PPD_1_Date > PPD_2_Date Then
Worksheets("PPDCI").Range("A" & j & ":C" & j).Value =
Worksheets("Data").Range("F" & i & ":H" & i).Value
Worksheets("PPDCI").Range("F" & j).Value = PPD_1_Date
j = j + 1
Else
If PPD_1_Date < PPD_2_Date Then
Worksheets("PPDCI").Range("A" & j & ":C" & j).Value =
Worksheets("Data").Range("F" & i & ":H" & i).Value
Worksheets("PPDCI").Range("F" & j).Value = PPD_2_Date
Worksheets("PPDCI").Range("G" & j).Value = "ELSE IF CONDITION"
j = j + 1
Else
'If IsEmpty(Worksheets("Data").Range(PPD_1_Date & i).Value) = True And
IsEmpty(Worksheets("Data").Range(PPD_2_Date & i).Value) = True Then
'GoTo EmptyRange
'Else
Worksheets("Error").Range("A" & k & ":C" & k).Value =
Worksheets("Data").Range("F" & i & ":H" & i).Value
Worksheets("Error").Range("F" & j).Value = "REVIEW PPD DATA"
k = k + 1
'End If
End If
End If
EmptyRange:
'k = k + 1
Next i
End Function
I would expect all the rows that qualify for the final Else statement to be grouped together and not missing any of the cells. Should I be incrementing k (k = k+1) somewhere else in the code? Any feedback is appreciated!

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

Using Month function in 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

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.