Nested Conditions In VBA - excel

I am new to excel and VBA so apologies for silly question or mistake.
i have some 2000 excel data in sheet2 and the data req in sheet 1
I need to know how many ticket which starts with INC and priority P2 P3 are there and same way how many tickets which starts with SR are there. also out of them how many are in closed state and how many are active.
Sub US_Data()
Dim z As Long
Dim C As Range
z = Sheet2.Cells(Rows.Count, 1).End(xlUp).Row
For Each C In Sheet2.Range(Sheet2.Cells(2, 1), Sheet2.Cells(z, 1))
If Left(C.Value, 3) = "INC" Then
Sheet1.Cells(8, 6) = Sheet1.Cells(8, 6) + 1
End If
Next C
End Sub
Thank you

Why use VBA at all? This can be done with simple formulas. If you don't want to use pivot tables, manually create the headings (Blue in the screenshot), then put this formula into cell H3, copy across and down.
=COUNTIFS($A:$A,$G3&"*",$B:$B,H$1,$C:$C,H$2)
Change the layout if you want. The point is that you don't need VBA for that. Formulas will be a lot faster than re-inventing a CountIfs with VBA.

Sub US_Data()
Dim z As Long
Dim HighCount as Long
Dim ModerCount as Long
Dim LowCount as Long
Dim OpenCount as Long
Dim ClosedCount as Long
Dim C As Range
z = Sheet2.Cells(Rows.Count, 1).End(xlUp).Row
For Each C In Sheet2.Range(Sheet2.Cells(2, 1), Sheet2.Cells(z, 1))
If Left(C.Value, 3) = "INC" Then
If C.Offset(0,1).Value = "2 - High" Then HighCount = HighCount + 1
If C.Offset(0,1).Value = "3 - Moderate" Then ModerCount = ModerCount + 1
If C.Offset(0,1).Value = "4 - Low" Then LowCount = LowCount + 1
If C.Offset(0,2).Value = "Closed" Then ClosedCount = ClosedCount + 1
If C.Offset(0,2).Value = "Open" Then OpenCount = OpenCount + 1
End If
Next C
MsgBox "I have counted " & HighCount & " times High, " & ModerCount & " times Moderate, " & LowCount & " times Low, and respectively " & OpenCount & " and " & ClosedCount & " open and closed instances.", vbOkOnly, "FYI"
Sheet1.Cells(8, 6) = HighCount
End Sub
This would be one way of doing it, you can fill the cells necessary with those variables.

Related

How to run the same VBA code on multiple rows

I have a loop that runs until a condition is met in Row 8.
Sub Button1_Click()
Dim i As Double
Dim x As Double
t = Range("K3").Value
i = Range("C8").Value
x = Range("E8").Value
b = Range("B8").Value
Do Until i > (x + t)
i = i + 0.2
Loop
i = i - 0.2 - b
Range("G8").Value = i
End Sub
This does what I require for Row 8 but I need to run on multiple rows. The only value that will be static is cell 'K3'.
i.e.: Once it is done on row 8, run on Row 9 ('C9','E9','B9','G9') and so on. Either this will need to run until row 500, or a count of rows entered.
There will be a whole heap of people here that will give you a much more complete answer but I'm here to answer your direct question.
If you need to apply other enhancements then that can come with other questions. This will help you learn and progress without throwing a heap of code at you that you're not sure of.
Sub Button1_Click()
Dim i As Double
Dim x As Double
Dim lngRow As Long
t = Range("K3").Value
For lngRow = 8 To 500
i = Range("C" & lngRow).Value
x = Range("E" & lngRow).Value
b = Range("B" & lngRow).Value
Do Until i > (x + t)
i = i + 0.2
Loop
i = i - 0.2 - b
Range("G" & lngRow).Value = i
Next
End Sub
That's a simple way to loop through each row.
Considerations you should make on performance are to do with looping, updating cells constantly, calculations and events when updating cells, etc.
But that answers your question.

Average ten values and then loop through to the next ten values until there are no more values

I have a dataset that consists of 5 different variables. As shown below.
Value1 Value 2 Value 3 Value 4 Value 5
1200.08031 104.9940186 28.05707932 23.90201187 1198.955811
1200.01948 105.0005951 28.05075455 23.88057899 1198.984619
1199.9152 105.0007782 28.04256058 23.86779976 1199.18042
1199.90651 105.0114594 28.05139923 23.90410423 1199.148926
1200.01079 104.9975433 28.05404663 23.89129448 1198.660034
1199.97603 104.9940186 28.0475502 23.91586685 1198.932129
1199.89782 105.0007782 28.04875183 23.87851715 1198.928833
1200.01948 105.0056458 28.04198837 23.91583633 1199.087524
1199.87175 105.0026855 28.04278946 23.91485214 1198.896851
1199.97603 105.0054626 28.04265976 23.9235096 1199.426514
Each of these variables has around 15,000 data points. To reduce the number of data points I want to average every ten data points into one data point and assign this value to a cell on another sheet. I want it to look like:
Value1Avg Value 2Avg Value 3Avg Value 4Avg Value 5Avg
1200.08031 104.9940186 28.05707932 23.90201187 1198.955811
I cannot get the average function to loop through every ten data points.
I have tried to run a loop that goes through each column and averages the values and places them on a different sheet, but I am not incrementing the variables correctly I believe.
Set wb = ThisWorkbook
Set sht1 = wb.Sheets("RawData")
Set sht2 = wb.Sheets("FilteredData")
ii = 2
j = 11
dd = 2
k = 20
n = 1
LastRow = sht1.Range("A:A").Find("*", searchdirection:=xlPrevious).Row
For i = 1 To LastRow
Set Myrange = sht1.Range("E" & ii, "E" & j)
sht2.Range("A" & n).Value =Application.WorksheetFunction.Average(Myrange)
Set Myrange = sht1.Range("B" & ii, "B" & j)
sht2.Range("B" & n).Value = Application.WorksheetFunction.Average(Myrange)
Set Myrange = sht1.Range("C" & ii, "C" & j)
sht2.Range("C" & n).Value = Application.WorksheetFunction.Average(Myrange)
Set Myrange = sht1.Range("H" & ii, "H" & j)
sht2.Range("E" & n).Value = Application.WorksheetFunction.Average(Myrange)
Set Myrange = sht1.Range("D" & ii, "D" & j)
sht2.Range("D" & n).Value = Application.WorksheetFunction.Average(Myrange)
ii = ii + 10
j = j + 10
n = n + 1
Next i
I expect to go to sheet 2 and see the averages, but I get:
"Run-time error '1004': Method 'Range' of object '_Worksheet' failed"
Here is a potential alternative that may be a little easier to follow by making use of nested loops. This way you do not have to complete the average for each column one by one, instead you can just have your action line written once situated inside a row & column loop.
Simplifying variables will also make this easier to update / debug in the future.
Sub Jeeped()
Dim rd As Worksheet: Set rd = ThisWorkbook.Sheets("RawData")
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("FilteredData")
Dim LR As Long
LR = rd.Range("A" & rd.Rows.Count).End(xlUp).Row
Dim c As Long 'Column Loop
Dim r As Long 'Row Loop
Dim x As Long 'Paste counter
x = 2
Dim TempAverage As Range
For r = 2 To LR Step 10
For i = 1 To 5 '<-- (Columns A - D)
Set TempAverage = rd.Range(rd.Cells(r, i), rd.Cells(r + 9, i))
ws.Cells(x, i).Value = Application.WorksheetFunction.Average(TempAverage)
Next i
x = x + 1
Next r
End Sub
assumes your variables span Columns A:D on RawData and that the values will be pasted on FilterdData on Columns A:D as well. You can modify the loops to place them in the correct location
https://i.stack.imgur.com/RKcpe.png

Create hierarchy based on pre-defined levels in Excel (Formula or VBA)

Below is my current Excel table:
I want to automatically generate the third column in yellow as a hierarchical view of all activities. I tried to solve this challenge with formulas but I am not sure that would be the best way to do it.
Has someone already faced and solved this requirement in Excel? Any advice/suggestions to guide me?
Many thanks and best regards!
You can paste this macro in the Worksheet's code Module and run it from there:
Sub CalculateHierarchy()
Dim rLevels As Range, rLevel As Range
Dim level As Integer, maxLevels As Integer, cur As Integer, i As Integer
Dim h As String, counts() As Integer
Set rLevels = Range("A2:A" & Range("A1").End(xlDown).Row)
maxLevels = WorksheetFunction.Max(rLevels)
ReDim counts(1 To maxLevels)
cur = 1
For Each rLevel In rLevels
level = rLevel.Value
If level > cur + 1 Then
rLevel.Activate
MsgBox "error at row " & rLevel.Row & " level increase by more than 1"
Exit Sub
End If
h = ""
counts(level) = counts(level) + 1
For i = 1 To level
h = h & "." & counts(i)
Next
h = Mid(h, 2)
For i = level + 1 To UBound(counts)
counts(i) = 0
Next
rLevel.Offset(, 2).Value = h
cur = level
Next
rLevel.Offset(0, 2).Interior.ColorIndex = 6
End Sub

copy select data from one sheet to a new worksheet

I am new to creating macros in Excel, and I am in a difficult position. I have a woorksheet of 48 columns and 6000+ rows. I have to retrieve select data from 20 columns and all rows, and place them into table of 3 columns and equal number of rows. For example Copy Sheet1: A2, E1, E3 and Paste into New Sheet3: A2, B2, C2. Needs to be automated due to size of spreadsheet, and the fact that the data is not formatted to be copied directly
I received an error 424 (Object Needed) using the following script.
Private Sub CommandButton1_Click()
Dim Counter As Integer
Counter = 3
Counter_H = 2
Do Until ThisWorkbook.Sheets("MASTER_LEAK_REPAIRS_CY2012").Cells(Counter, 4).Value = " "
thisworkbooks.Sheets("Sheet1").Select("A" & Counter, "B" & Counter, "C" & Counter).Value = thisworkbooks.Sheets("MASTER_LEAK_REPAIRS_CY2012").Select("D" & Counter, "Q" & (Counter - Counter_H), "Q" & Counter).Value
Counter = Counter + 1
Counter_H = Counter + 1
Loop
End Sub
Please help me.
New answer, based on below comment.
Private Sub CommandButton1_Click()
Dim Counter As Integer
Counter = 3
Counter_H = 2
Do Until ThisWorkbook.Sheets("MASTER_LEAK_REPAIRS_CY2012").Cells(Counter, 4).Value = ""
ThisWorkbook.Sheets("Sheet1").Range("A" & Counter) = ThisWorkbook.Sheets("MASTER_LEAK_REPAIRS_CY2012").Range("D" & Counter)
ThisWorkbook.Sheets("Sheet1").Range("B" & Counter) = ThisWorkbook.Sheets("MASTER_LEAK_REPAIRS_CY2012").Range("Q" & (Counter - Counter_H))
ThisWorkbook.Sheets("Sheet1").Range("C" & Counter) = ThisWorkbook.Sheets("MASTER_LEAK_REPAIRS_CY2012").Range("Q" & Counter)
Counter = Counter + 1
Counter_H = Counter + 1
Loop
End Sub
When I tried you original, I received error 450, but with this I did not.
Let me know if you have any problems!

Disconnect between address assigned in code to named range and the resulting named range address

I am trying to write a VBA script in Excel 2003 (not my choice of version) to partition a predefined range on a worksheet into ten named ranges. The worksheet name is "paste_data" and the 'block' of cells that I want to confine the script to is A4:AO111. Sometimes, when I run the script, it works, but at other times, it seems to shift the effective starting cell from A4 to another cell. Here is an example of bad results (sorry, I can't post an image because I'm new):
The named range table.emergency.count refers to range V6:AO25 when it should refer to range V4:AO23.
My code is here:
Sub tables_assign()
Dim j As Integer
Dim range_ref, range_name, rref As String
Dim tbles(1 To 10) As String
Dim rw1, rw2 As Integer
'##########################################################################################
'CREATION AND NAMING OF TABLES
'##########################################################################################
tbles(1) = "table.emergency.score": tbles(2) = "table.emergency.count": tbles(3) = "table.eol.score": tbles(4) = "table.eol.count": tbles(5) = "table.inpatient.score": tbles(6) = "table.inpatient.count": tbles(7) = "table.outpatient.score": tbles(8) = "table.outpatient.count": tbles(9) = "table.sds.score": tbles(10) = "table.sds.count"
For j = 1 To 10
If j Mod 2 <> 0 Then
If j = 1 Then
rw1 = 4
rw2 = 23
Else
rw1 = 4 + 22 * Application.WorksheetFunction.Ceiling((j / 2 - 1), 1)
rw2 = 23 + 22 * Application.WorksheetFunction.Ceiling((j / 2 - 1), 1)
End If
rref = Trim(Application.WorksheetFunction.Substitute("=paste_data!A" & Str(rw1) & ":T" & Str(rw2), " ", ""))
ActiveWorkbook.Names.Add tbles(j), rref
Else
If j = 2 Then
rw1 = 4
rw2 = 23
Else
rw1 = 4 + 22 * (j / 2 - 1)
rw2 = 23 + 22 * (j / 2 - 1)
End If
rref = Trim(Application.WorksheetFunction.Substitute("=paste_data!V" & Str(rw1) & ":AO" & Str(rw2), " ", ""))
ActiveWorkbook.Names.Add tbles(j), rref
End If
Next j
End Sub
Does anyone have an idea why this would happen? My hunch is that the worksheet's 'usedrange' is the culprit.
When you use relative references in defined names, the definition is relative to the activecell. To avoid that, use absolute references, like $V$4:$AO$23. With absolute references, the named range will always point to the same cells.
Example:
Select cell A1 and define the name test_relative as "=A1". Now select cell B10 and reopen the defined name box, select test_relative and you'll see something like "=Sheet1!B10"
To fix your code, insert the $ in the range references
rref = Trim(Replace("=paste_data!$A$" & Str(rw1) & ":$T$" & Str(rw2), " ", ""))
Also note that
Dim rw1, rw2 As Integer
dimensions rw1 as a Variant. Use
Dim rw1 As Integer, rw2 As Integer

Resources