The section that says: RowCount = Cells(Rows.Count, "A").End(x1Up).Row, is highlighted in red and yellow when I select debug. I'm not sure what that is supposed to mean.
Sub DQAnalysis()
Worksheets("DQ Analysis").Activate
Range("A1").Value = "DAQ0 (Ticker: DQ)"
'Create a header row
Cells(3, 1).Value = "Year"
Cells(3, 2).Value = "Total Daily Volume"
Cells(3, 3).Value = "Return"
Worksheets("2018").Activate
'set initial volume to zero
totalVolume = 0
Dim startingPrice As Double
Dim endingPrice As Double
'find the number of rows to loop over
RowCount = Cells(Rows.Count, "A").End(x1Up).Row
'loop over all the rows
For i = 2 To RowCount
If Cells(i, 1).Value = "DQ" Then
'increase totalVolume by the value in the current row
totalVolume = totalVolume + Cells(i, 8).Value
End If
If Cells(i - 1, 1).Value <> "DQ" And Cells(i, 1).Value = "DQ" Then
endingPrice = Cells(i, 6).Value
End If
If Cells(i + 1, 1).Value <> "DQ" And Cells(i, 1).Value = "DQ" Then
endingPrice = Cells(i, 6).Value
End If
Next i
Worksheets("DQ Analysis").Activate
Cells(4, 1).Value = 2018
Cells(4, 2).Value = totalVolume
Cells(4, 3).Value = (endingPrice / startingPrice) - 1
End Sub
This line calculates the last row's count, you can use this code:
RowCount = Range("A100000").End(xlUp).Row
It means select "A100000" cell and go up to find a cell that not null. It shows the last row of our table on A column.
Related
Sub CreateTableD()
Dim WB As Workbook
Dim WS1 As Worksheet
Dim WS2 As Worksheet
Dim i As Long
Dim k As Long
'Dim n As Long
Set WB = Excel.ActiveWorkbook
Set WS1 = WB.Worksheets("List1")
Set WS2 = WB.Worksheets("List2")
i = 1
k = 1
'While Not IsEmpty(WS1.Cells(i, 1))
Do While WS1.Cells(i, 1).Value <> ""
If (WS1.Cells(i, 4).Value = "Depo" And WS1.Cells(i, 8).Value = "CZK") Then
WS2.Cells(k + 1, 4).Value = WS1.Cells(i, 7).Value
WS2.Cells(k + 2, 4).Value = WS1.Cells(i, 7).Value
WS2.Cells(k + 1, 7).Value = "79010000"
WS2.Cells(k + 2, 7).Value = "79010000"
ElseIf (WS1.Cells(i, 4).Value = "Loan" And WS1.Cells(i, 8).Value = "CZK") Then
WS2.Cells(k + 1, 4).Value = WS1.Cells(i, 7).Value
WS2.Cells(k + 2, 4).Value = WS1.Cells(i, 7).Value
WS2.Cells(k + 1, 7).Value = "75010000"
WS2.Cells(k + 2, 7).Value = "75010000"
k = k + 2
End If
i = i + 1
'Wend
Loop
Range("D1").Select
ActiveCell.FormulaR1C1 = "CZK"
End Sub
Hi. I have a code, but it doesnt work properly. If two conditions are satisfied it must return interest on another worksheet and also some static data( which is in the code) I've shown the right result on second picture.
first worksheet with conditions
on this picture i showed what i need to get
The problem is that you are only incrementing k when it is a loan.
If (WS1.Cells(i, 4).Value = "Depo" And WS1.Cells(i, 8).Value = "CZK") Then
ElseIf (WS1.Cells(i, 4).Value = "Loan" And WS1.Cells(i, 8).Value = "CZK") Then
k = k + 2
End If
Incrementing k when eith condition is True will fix the problem.
If (WS1.Cells(i, 4).Value = "Depo" And WS1.Cells(i, 8).Value = "CZK") Then
k = k + 2
ElseIf (WS1.Cells(i, 4).Value = "Loan" And WS1.Cells(i, 8).Value = "CZK") Then
k = k + 2
End If
I usually create a separate function to handle adding data to a table. Breaking up the code into smaller units helps simplify debugging.
Here is how I would write it.
Sub CreateTableD()
Dim x As Long
With Worksheets("List1")
For x = 2 To .Range("D" & .Rows.Count).End(xlUp).Row
If .Cells(x, 8).Value = "CZK" Then
If .Cells(x, 4).Value = "Depo" Then
AddList2Entry .Cells(x, 7).Value, "79010000"
AddList2Entry .Cells(x, 7).Value, "79010000"
ElseIf .Cells(x, 4).Value = "Loan" Then
AddList2Entry .Cells(x, 7).Value, "75010000"
AddList2Entry .Cells(x, 7).Value, "75010000"
End If
End If
Next
End With
End Sub
Sub AddList2Entry(interest As Double, StaticValue As Double)
Dim newRow As Long
With Worksheets("List2")
newRow = .Range("D" & .Rows.Count).End(xlUp).Row + 1
.Cells(newRow, "D").Value = interest
.Cells(newRow, "G").Value = StaticValue
End With
End Sub
Sub AutoFill()
Dim x As Long
Dim y As Long
Dim lastrow As Long
Dim lastcolumn As Long
Application.ScreenUpdating = False
Application.DisplayAlerts = False
lastcolumn = ActiveSheet.UsedRange.Column - 1 + ActiveSheet.UsedRange.Columns.Count
lastrow = ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count
For x = 2 To lastrow
If Cells(x, 2).Value = "" Then
Cells(x, 2).Value = Cells(x - 1, 2).Value
Cells(x, 3).Value = Cells(x - 1, 3).Value
Cells(x, 5).Value = Cells(x - 1, 5).Value
End If
Next x
Application.ScreenUpdating = True
End Sub
With the above code My cells are being filled up, but the last row fills till the end of excel sheet. In the Excel sheet column D is already filled in Column B C & E should be auto fill to down. What should be the changes in the code?
Excel VBA Last Row: The Complete Tutorial To Finding The Last Row In Excel With VBA (And Code Examples) recommends using LookIn:=xlFormulas when determining the last with using Cells.Find.
lastrow = Find(What:=” * ”, LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Because you stated that column D is already filled in I use:
lastrow = Range("D" & Rows.Count).End(xlUp).Row
If column E isn't filled in then Cells(x, 2).Value must be <> "".
Sub AutoFill()
Dim x As Long
Dim y As Long
Dim lastrow As Long
Dim lastcolumn As Long
Application.ScreenUpdating = False
Application.DisplayAlerts = False
lastcolumn = ActiveSheet.UsedRange.Column - 1 + ActiveSheet.UsedRange.Columns.Count
lastrow = Range("D" & Rows.Count).End(xlUp).Row
For x = 2 To lastrow
If Cells(x, 2).Value = "" Then Cells(x, 2).Value = Cells(x - 1, 2).Value
If Cells(x, 3).Value = "" Then Cells(x, 3).Value = Cells(x - 1, 3).Value
If Cells(x, 5).Value = "" Then Cells(x, 5).Value = Cells(x - 1, 4).Value
Next x
Application.ScreenUpdating = True
End Sub
I am new here.
I am trying to build a quick VBA program to "flatten" a Bill of Materials by heirarchy (BOM Level) and Status.
Here is some sample data:
The sample data shows a BOM with a Car as a top level assembly, Wheel and Engine as second level assemblies, and various children parts that make up those assemblies on the third and fourth level of the BOM.
I want to delete any rows that have the value "ZE", "ZM", or blank in column C.
I also want to delete any rows that have the value "ZA" and are also direct children of another "ZA" item. (Example - Delete the Rim row from the BOM because the Wheel is the Parent "ZA" item)
Here is what I have so far:
Sub deletechildren()
Dim lr As Long, i As Long, k As Long
lr = Cells(Rows.Count, 1).End(xlUp).Row
For i = lr To 1 Step -1
If i > 2 Then
k = i - 1
End If
If Cells(i, 3).Value = "ZA" And Cells(i, 1).Value = Cells(k, 1).Value Then
Cells(i, 3).EntireRow.Delete
ElseIf Cells(i, 3).Value = "ZE" Then
Cells(i, 3).EntireRow.Delete
ElseIf Cells(i, 3).Value = "ZM" Then
Cells(i, 3).EntireRow.Delete
ElseIf Cells(i, 3).Value = "" Then
Cells(i, 3).EntireRow.Delete
End If
Next i
lr = Cells(Rows.Count, 1).End(xlUp).Row
End Sub
I am getting some error on the first part of the If statement, where I want to parse out any "ZA" status children from the "ZA" parent.
Any ideas?
Sub DeleteChildren()
Dim lastRow As Long
Dim i As Long
lastRow = Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To lastRow
If (Cells(i, 3).Value = "ZE" Or Cells(i, 3).Value = "ZM" Or Cells(i, 3).Value = "") And Cells(i, 1) <> "" Then
Rows(i).EntireRow.Delete xlShiftUp
i = i - 1
GoTo NextIteration
End If
If Cells(i, 1).Value > 1 Then
If (Cells(i, 3).Value = "ZA" And Cells(i - 1, 3).Value = "ZA") And Not Cells(i, 1).Value < Cells(i - 1, 1).Value Then ' This way is a there are multiple levels with "ZA" there can
Cells(i, 5).Value = "Delete"
End If
End If
NextIteration:
Next i
lastRow = Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To lastRow
If Cells(i, 5).Value = "Delete" Then
Rows(i).EntireRow.Delete xlShiftUp
i = i - 1
End If
Next i
End Sub
A part of the problem is that the variable k is not being used to correctly identify parent/children relationships (if I understand your requirements correctly). In your case, you are comparing the each value with the row above it, but in a bill of materials, the parent row might be multiple rows above, and is denoted by a hierarchy value - 1.
See my revised code below. In the code, we first delete any rows that we know to delete (ZM, ZE, and Blanks). Next, we loop up the hierarchy values until we find one hierarchy value above the current row. That becomes the parent row, and from there, we test.
Let me know if you need additional help.
Sub deletechildren()
Dim lr As Long, i As Long, k As Long
lr = Cells(Rows.Count, 1).End(xlUp).Row
For i = lr To 1 Step -1
If i > 2 Then
k = i - 1
If Cells(i, 3) = "ZE" Or Cells(i, 3) = "ZM" Or Cells(i, 3) = "" Then
Rows(i).Delete
Else
k = i - 1
Do Until i <= 2 Or (Cells(i, 1) - Cells(k, 1) = 1)
k = k - 1
Loop
'Now, k represents the parent row.
If Cells(i, 3) = "ZA" And Cells(k, 3) = "ZA" Then
Rows(i).Delete
End If
End If
End If
Next i
lr = Cells(Rows.Count, 1).End(xlUp).Row
End Sub
I'd use Autofilter() and Sort() methods of Range object like follows:
Option Explicit
Sub deletechildren()
Dim i As Long
With Worksheets("BOM")
With .Range("A1:D" & .Cells(.Rows.Count, 1).End(xlUp).Row)
.AutoFilter Field:=3, Criteria1:=Array("ZE", "ZM", "="), Operator:=xlFilterValues
With .Offset(1).Resize(.Rows.Count - 1)
If Application.WorksheetFunction.Subtotal(103, .Columns(1)) > 1 Then .SpecialCells(xlCellTypeVisible).EntireRow.Delete
End With
.AutoFilter
.Sort key1:=Range("C1"), order1:=xlAscending, key2:=Range("A1"), order2:=xlAscending, Header:=xlYes
i = .Rows(.Rows.Count).Row
Do Until .Cells(i, 1) = .Cells(2, 1)
i = i - 1
Loop
If i < .Rows.Count Then .Rows(i + 1).Resize(.Rows.Count - i).EntireRow.Delete
End With
End With
End Sub
I have written a bit of code that is intended to search cells in a column, see if they start with a certain string and then return a value based on that string in another column. I have two problems, firstly the loops don't actually return any values in columns 8,9,10 or 11. Also the second loop doesn't stop running? Here is my code
Sub Possible_solution_one()
Dim i As Integer
Dim j As Integer
Dim ws As Worksheet
Set ws = ActiveSheet
For i = 2 To ws.Cells(ws.Rows.Count, "a").End(xlUp).Row
Do While Cells(i, 1).Value <> ""
If Cells(i, 2) = "Business://EXTRACTS/" & "*" Then
Cells(i, 8) = "OBS(" & Cells(i, 2).Value & ",SHARE,#DI) OR "
End If
i = i + 1
Loop
Next
For j = 2 To ws.Cells(ws.Rows.Count, "a").End(xlUp).Row
Do While Cells(j, 6).Value <> ""
If Cells(j, 6) = "Business" & "*" Then
Cells(j, 9) = "OBS(" & Cells(j, 4).Value & ",SHARE,DI) OR "
ElseIf Cells(j, 6) = "CSTM" Then
Cells(j, 10) = "PUM(" & Cells(j, 4).Value & ",#D7) OR "
ElseIf Cells(j, 6) = "*FS" Then
Cells(j, 11) = "FCON(" & Cells(j, 4).Value & ") OR "
End If
i = i + 1
Loop
Next
End Sub
To give the situation I have 1 type of string in column B and 3 types in column F. Am looking to return different things in columns 8,9,10,11 based on b and D
If you are pattern matching with wildcards, you need to use the Like operator. e.g. If Cells(i, 2) Like "Business://EXTRACTS/" & "*" Then
The Do While loops inside the For Next loops were unnecessary. It is also not a good idea to 'manually' increment the increment counter in a For ... Next loop.
The second loop was running forever because you were incrementing i, not j.
A Select Case statement would make a better fit for the multiple criteria in the second j loop.
Sub Possible_solution_one()
Dim i As Long, j As Long
Dim ws As Worksheet
Set ws = ActiveSheet
With ws
For i = 2 To .Cells(.Rows.Count, "a").End(xlUp).Row
If Not CBool(Len(Cells(i, "a").Value)) Then Exit For
If .Cells(i, 2) = "Business://EXTRACTS/" & "*" Then
.Cells(i, 8) = "OBS(" & .Cells(i, 2).Value & ",SHARE,#DI) OR "
End If
Next i
For j = 2 To .Cells(ws.Rows.Count, "a").End(xlUp).Row
Select Case .Cells(j, 6).Value
Case "Business*"
.Cells(j, 9) = "OBS(" & Cells(j, 4).Value & ",SHARE,DI) OR "
Case "CSTM"
.Cells(j, 10) = "PUM(" & Cells(j, 4).Value & ",#D7) OR "
Case "*FS"
.Cells(j, 11) = "FCON(" & Cells(j, 4).Value & ") OR "
End If
End Select
Next j
End With
End Sub
I've also incorporated a With ... End With statement to associate all of the cells to the parent ws worksheet. Note hte .Cells and not Cells. The prefixing period assigns parentage to the worksheet referenced in the With ... End With.
With no sample data, I could not completely test this rewrite but it does compile.
your second do while loop uses i=i+1 instead of j = j + 1 so it's not going to increment the cells(j, 6).value if there's anything in cells(j,6) then the loop won't stop running
For j = 2 To ws.Cells(ws.Rows.Count, "a").End(xlUp).Row
Do While Cells(j, 6).Value <> ""
If Cells(j, 6) = "Business" & "*" Then
Cells(j, 9) = "OBS(" & Cells(j, 4).Value & ",SHARE,DI) OR "
ElseIf Cells(j, 6) = "CSTM" Then
Cells(j, 10) = "PUM(" & Cells(j, 4).Value & ",#D7) OR "
ElseIf Cells(j, 6) = "*FS" Then
Cells(j, 11) = "FCON(" & Cells(j, 4).Value & ") OR "
End If
'i = i + 1
j = j + 1
Loop
Next
I have a very large excel file, around 50K rows. In Column (C) I have the person numbers 1,1,1,1,2,3,4,5,.... and in Column(N) I have the payments for this person, so the data looks like
What I want is to sum All payments for one person from column N and set the result in column O, then merge column O.
It looks like you're looking for the built-in excel SUMIF function
=sumif(C:C,"specific person number",N:N)
Sub summAndMerge()
lastrow = Worksheets("A").Range("A65536").End(xlUp).Row
For i = 2 To lastrow
If Cells(i, 1).Value <> Cells(i - 1, 1).Value And Cells(i, 1).Value <> Cells(i + 1, 1).Value Then
intUpper = i
Debug.Print ("<> -1 and <> +1 " & intUpper)
End If
If Cells(i, 1).Value <> Cells(i - 1, 1).Value And Cells(i, 1).Value = Cells(i + 1, 1).Value Then
intUpper = i
Debug.Print ("<> -1 and = +1 " & intUpper & " UPPPER LIMIT")
End If
If Cells(i, 1).Value <> Cells(i + 1, 1).Value And Cells(i, 1).Value = Cells(i - 1, 1).Value Then
Application.DisplayAlerts = False
Debug.Print ("<> +1 and = -1:" & i & "LOWER LIMIT")
Range(Cells(intUpper, 3), Cells(i, 3)).Merge
Cells(intUpper, 3).Value = "=sumif(B" & CStr(intUpper) & ":B" & CStr(i) & ","">0"")"
Range(Cells(i, 1), Cells(i, 24)).Borders(xlEdgeBottom).LineStyle = xlDouble
End If
If Cells(i, 1).Value <> Cells(i + 1, 1).Value And Cells(i, 1).Value <> Cells(i - 1, 1).Value Then
Debug.Print ("One Cells: " & i)
Range(Cells(i, 1), Cells(i, 24)).Borders(xlEdgeBottom).LineStyle = xlDouble
Cells(intUpper, 3).Value = Cells(intUpper, 2).Value
End If
Next i
End Sub