I have a sheet that pulls columns of data from an external source, and a macro which then uses that data to calculate and populate other columns in the sheet. The calculation outputs on each row depend on the values of the row above. Ultimately, I would like to set the value of one column in the very last row to zero, by changing the input data in one of the first cells. If this were all Excel formulas then I could do a simple Goal Seek, but all of the calculations are carried out in vba.
I am new to vba so I'm not sure if what I'm asking is even possible. Here is an example of how my macro for the calculations looks:
Public Sub Calculate()
i = 2
Do While Cells(i, 3) <> ""
Cells(i, 31).Value = Cells(i, 30) / (1 + Cells(i, 61))
Cells(i, 28).Value = -Cells(i, 14) * Cells(i, 31)
Cells(i, 27).Value = (-Cells(i, 26) * Cells(i, 2))
Cells(i, 32).Value = Cells(i, 15) + Cells(i, 2) + Cells(i,27)
Cells(i, 29).Value = Cells(i, 61) * (Cells(i, 15) + Cells(i, 2)
Cells(i, 61).Value = (Cells(i, 60) + 1)
Cells(i, 62).Value = (Cells(18, 3) + 1)
Cells(i + 1, 15).Value = Cells(i, 32)
Cells(i + 1, 16).Value = Cells(i, 33)
i = i + 1
Loop
End Sub
Basically, the value of the last row of column 32 (AF) depends on the value of the first row of column 2 (B). So I would like to vary the value of B2 to make AF500 = 0, based on these calculations. I would love to avoid having formulas in the sheet so I hope this is possible. Thank you for taking the time to read, and sorry for the awful code.
Related
Private Sub CommandButton1_Click()
Dim nbp As Long
Dim i As Long
Dim p As Long
Dim FV As Variant
Dim CS As Variant
Dim K As Variant
Dim iFV As Integer
Dim iCS As Double
If Range("B9") = "Semi-Annual" Then
p = DateDiff("yyyy", Cells(4, 3), Cells(5, 3))
nbp = p * 2
For i = 5 To nbp + 4
Cells(5, 10).Value = Cells(4, 3).Value
Cells(i + 1, 10).Value = DateAdd("m", 6, Cells(i, 10).Value)
Next i
For i = 6 To nbp + 5
Cells(i, 14).Value = Cells(7, 2).Value * (Cells(8, 2).Value / 2)
Next i
FV = Sheet2.Range("J5:J10").Value
CS = Sheet3.Range("F1:G8000").Value
For iFV = 1 To UBound(FV)
For iCS = 1 To UBound(CS, 2)
If FV(iFV, 1) = CS(iCS, 1) Then
K(iFV, 1) = CS(iCS, 2)
End If
Next
Next
Sheet2.Range("K5:K10").Value = K
End If
End If
If Range("B9") = "Annual" Then
nbp = DateDiff("yyyy", Cells(4, 3), Cells(5, 3))
For i = 5 To nbp + 4
Cells(5, 10).Value = Cells(4, 3).Value
Cells(i + 1, 10).Value = DateAdd("m", 12, Cells(i, 10).Value)
Next i
End if
If Range("B9") = "Quarterly" Then
p = DateDiff("yyyy", Cells(4, 3), Cells(5, 3))
nbp = p * 4
For i = 5 To nbp + 4
Cells(5, 10).Value = Cells(4, 3).Value
Cells(i + 1, 10).Value = DateAdd("m", 3, Cells(i, 10).Value)
Next i
End If
If Range("B9") = "Monthly" Then ' to choose from a list .
p = DateDiff("yyyy", Cells(4, 3), Cells(5, 3))
nbp = p * 12
For i = 5 To nbp + 4
Cells(5, 10).Value = Cells(4, 3).Value
Cells(i + 1, 10).Value = DateAdd("m", 3, Cells(i, 10).Value)
Next i
End If
End Sub
I have added all the code in the button to help. i am not sure if that will help, anyway here is it. if the user chooses semi annual then couple of things take place. Same goes for the rest "ifs" but i need to fix this issue first then move on to the rest. the code to too long, it is simple and not complicated.
Now that more of the code is posted, I think I understand what the problem is.
Wherever you reference Cells() VBA assumes it applies to ActiveSheet. And I think you should fully qualify the calls to be Sheet2.Cells() for example or whatever you need.
When you call the code behind a button, the button resides on a sheet and it references the cells on that sheet. But when you moved the code to a module it no longer referenced the sheet with the button, but whatever other sheet was active at the time.
So whenever you see Cells() or Range() without a worksheet specification in front of it, change it so that it you target a specific worksheet.
PS. Avoid using Integer and prefer Long instead. Also, prefer relative referencing such as Sheet2.Range("G2").Cells(i,j) instead of absolute referencing Sheet2.Cells(1+i, 6+j) or string math such as Sheet2.Range("G" & 1+i & ":G" & 5+i).
I have 30 excel files need to be done with the same operation. I have non-fixed number of rows in my excel files. For all excel files, I want to apply VBA to write IF function into the column"H" from the second row to the last row.
Here is the formula I need to write (for the second row): =IF(AND(C2=C3,C2=C1,G2=TRUE,G1=FALSE,G3=TRUE),"O",IF(AND(C2=C3,C2<>C1,G2=TRUE),"FromYes",IF(AND(C2=C1,C2=C3,G2=TRUE,G1=TRUE,G3=FALSE),"D",IF(AND(C2=C1,C2<>C3,G2=TRUE),"ToTmr",""))))
Other rows shall have similar formula.
Is there any way for me to write a formula directly in vba for the whole column "H"?
I have tried some code like this, but it run extremely slow
For x = 2 To lastRow
If ws.Cells(x, 3) = ws.Cells(x + 1, 3) And ws.Cells(x, 3) = ws.Cells(x - 1, 3) And ws.Cells(x, 7) = True And ws.Cells(x - 1, 7) And ws.Cells(x + 1, 7) = True Then
ws.Cells(x, 8) = "O"
Else
If Cells(x, 3) = Cells(x + 1, 3) And (Cells(x, 3) <> Cells(x - 1, 3)) And Cells(x, 7) = True Then
Cells(x, 8) = "FromYes"
Else
If Cells(x, 3) = Cells(x - 1, 3) And Cells(x, 3) = Cells(x + 1, 3) And Cells(x, 7) = True And Cells(x - 1, 7) = True And Cells(x + 1, 7) = False Then
Cells(x, 8) = "D"
Else
If Cells(x, 3) = Cells(x - 1, 3) And Cells(x, 3) <> Cells(x + 1, 3) And Cells(x, 7) = True Then
Cells(x, 8) = "ToTmr"
End If
End If
End If
End If
Next x
Next d
There are a few things to change in your approach. Firstly, use the fact that you can set cell formulas with VBA. Secondly, use the fact that you can set cell formulas for an entire range in VBA. Thirdly, if your formula is fast, use it instead of code (this is not a hard and fast rule, but if you're new to VBA or not using it often, it's simpler to use formulas).
Using those ideas, I came up with this:
With Sheet1
.Range(.Cells(2, 8), .Cells(lastRow, 8)).FormulaR1C1 = _
"=IF(AND(RC[-5]=R[1]C[-5],RC[-5]=R[-1]C[-5],RC[-1],NOT(R[-1]C[-1]),R[1]C[-1]),""O""," & _
"IF(AND(RC[-5]=R[1]C[-5],RC[-5]<>R[-1]C[-5],RC[-1]),""FromYes""," & _
"IF(AND(RC[-5]=R[1]C[-5],RC[-5]=R[-1]C[-5],RC[-1],R[-1]C[-1],NOT(R[1]C[-1])),""D""," & _
"IF(AND(RC[-5]<>R[1]C[-5],RC[-5]=R[-1]C[-5],RC[-1]),""ToTmr"",""""))))"
End With
This is setting the formula for the range of column H, rows 2 through the lastRow, for Sheet1 equal to your formula. The removes the need to loop rows, making it much quicker.
I always find it is easier to work with R1C1 format when entering formulas through VBA. It's easy enough to get that format; you just need to go the formula options in Excel and select R1C1 Reference Style. Then you can copy it into the VBA and escape quotation marks with another quotation mark.
Using this, you can easily write a tool that loops through the files, finds the last row on the appropriate sheet, and sets the formula.
For the first time I've worked in Excel VBA to find rows in my dataset that contain the same adress as another entry in a cluster. These entries have to be merged and the row then is deleted. I've come up with the following, which works (As far as I can tell from the testing I did on small samples of the set):
Sub Merge_Orders()
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Dim lastrow As Long
lastrow = Cells(Rows.Count, "A").End(xlUp).Row
Dim y As Long
Dim x As Long
Dim j As Long
Dim k As Long
For i = 2 To lastrow //for each row, starting below header row
j = 1
y = (Cells(i, 9)) //this is the clusternumber
Do While y = (Cells(i + j, 9)) //while the next row is in the same cluster
x = (Cells(i, 12)) //this is the adresscode
k = 1
Do While x = (Cells(i + k, 12)) //while the current adresscode is the same as the next, iterating until another adresscode is hit
Cells(i, 16) = Val(Cells(i, 16)) + Val(Cells(i + k, 16)) //update cell value
Cells(i, 18) = Cells(i, 18) + Cells(i + k, 18) //update cell value
Cells(i, 19) = Cells(i, 19) + Cells(i + k, 19) //update cell value
If Cells(i, 20) > Cells(i + k, 20) Then
Cells(i, 20) = Cells(i + k, 20) //update cell value
End If
If Cells(i, 21) > Cells(i + k, 21) Then
Cells(i, 21) = Cells(i + k, 21) //update cell value
End If
Cells(i, 22) = Cells(i, 22) + Cells(i + k, 22) //update cell value
Cells(i, 23) = Cells(i, 23) + Cells(i + k, 23) //update cell value
Rows(i + 1).EntireRow.Delete //Delete the row from which data was pulled
k = k + 1
Loop
j = j + 1
Loop
Next i
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
End Sub
The problem I'm facing is time. Testing this on a small sample of ~50 rows took over 5 minutes. My entries total over 100K rows. It's been running for over a day with no end in sight. Is there a way to optimize this so I don't have to wait until I'm grey?
Kind regards,
Rob
Two things as I mentioned in the comments:
1) Remove k (and the entire k=k+1 line); replace with j. Also replace your Rows(i + 1).EntireRow.Delete with Rows(i + j).EntireRow.Delete.
2) Since you are deleting rows, lastrow is actually blank by the time you get there. Instead of i=2 to lastrow, make it do while Cells(i,12)<>"" or something. This is causing it to loop over a bunch of rows that are empty.
Also, you can do these type of rollups much easier with a PivotTable, or, as mentioned in the comments, with an SQL GROUP BY.
I'm currently diving into code/VBA coding for the first time. I have a file that I dump into a worksheet that currently I'm manually organizing and pushing out. When put into the worksheet, it delimits itself across the cells. The first 2-4 cells are always parts of a name. This dump file will have varying row and column lengths every time I get it in a given day and dump into a work sheet. For example, one day it may be twenty rows and one day it may be thirty.
This is a rough illustration of what the data looks like, but my code probably doesn't match with the example below - I just wanted to provide a visual:
So, I'm wanting to make code that will start at A1 and concatenate the cells following it until it runs into a blank cell in that row. Then it places the concatenated data into cell A1 and removes the values it pulled the name pieces from and slides all the data to the left. After that, it continues the same operation on the next row until it meets the final row. As you can see in the image, I don't want any of the data after the blank cell to be affected.
This is my first time programming in general, so when you provide assistance, would you please explain your code so I can learn the concepts? Here's what I think will work so far... I'm just stuck on how to go about concatenating.
The code I currently have:
Sub DN_ERROR_ORGANIZER()
Dim row As Integer
NumRows = Range("A1", Range("A1").End(xldown)).Rows.Count
Range("A1").Select
For row = 1 To NumRows
Do Until IsEmpty(ActiveCell)
' Code to concatenate
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.Offset(1, 0).Select
Next
End sub
Here's another way to look at your problem: Suppose you have your table on Sheet2, and the result is reflected on Sheet1.
Sub PutInOrder()
filledcells = 0
'''lastrow = Sheet2.Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To 100
If Sheet2.Cells(i, 1) = "" Then Exit For
For a = 1 To 4
If Sheet2.Cells(i, a) = "" Then Exit For
If Sheet2.Cells(i, a) <> "" Then
filledcells = filledcells + 1
End If
Next
Select Case filledcells
Case Is = 2
Sheet1.Cells(i, 1) = Sheet2.Cells(i, 1) + ", " + Sheet2.Cells(i, 2)
Sheet1.Cells(i, 3) = Sheet2.Cells(i, 4)
Sheet1.Cells(i, 4) = Sheet2.Cells(i, 5)
Sheet1.Cells(i, 5) = Sheet2.Cells(i, 6)
Sheet1.Cells(i, 6) = Sheet2.Cells(i, 7)
Case Is = 3
Sheet1.Cells(i, 1) = Sheet2.Cells(i, 1) + ", " + Sheet2.Cells(i, 2) + " " + Sheet2.Cells(i, 3)
Sheet1.Cells(i, 3) = Sheet2.Cells(i, 5)
Sheet1.Cells(i, 4) = Sheet2.Cells(i, 6)
Sheet1.Cells(i, 5) = Sheet2.Cells(i, 7)
Sheet1.Cells(i, 6) = Sheet2.Cells(i, 8)
Case Is = 4
Sheet1.Cells(i, 1) = Sheet2.Cells(i, 1) + ", " + Sheet2.Cells(i, 2) + " " + Sheet2.Cells(i, 3) + " " + Sheet2.Cells(i, 4)
Sheet1.Cells(i, 3) = Sheet2.Cells(i, 6)
Sheet1.Cells(i, 4) = Sheet2.Cells(i, 7)
Sheet1.Cells(i, 5) = Sheet2.Cells(i, 8)
Sheet1.Cells(i, 6) = Sheet2.Cells(i, 9)
End Select
filledcells = 0
Next
End Sub
Can you try this and let me know how you get on? It may need some tweaks depending on your precise layout. My approach is slightly different.
Sub x()
Dim n As Long, r1 As Range, r2 As Range, v
For n = 1 To Range("A" & Rows.Count).End(xlUp).Row
On Error Resume Next
Set r1 = Cells(n, 1).EntireRow.SpecialCells(xlCellTypeConstants).Areas(1)
Set r2 = Cells(n, 1).EntireRow.SpecialCells(xlCellTypeConstants).Areas(2)
If Not r1 Is Nothing And Not r2 Is Nothing Then
v = Join(Application.Transpose(Application.Transpose(r1)), ", ")
Cells(n, 1) = WorksheetFunction.Proper(v)
Cells(n, 2).Resize(, r1.Count).Clear
r2.Cut Cells(n, 3)
End If
Next n
End Sub
I want to automatically update sheet 2 & sheet 3 from sheet 1 as per data. It will be helpful if it gets resolved.
I am new to visual basic coding so unaware of its script but aware of c++. Whatever the solution may be it will be helpful.
Screen shot of the three sheets - I was unable to upload the Excel files
I have tried the following code:
Sub FindMatches()
Dim oldrow As Integer
Dim newrow As Integer
For oldrow = 4 To 14
For newrow = 3 To 20
If Cells(oldrow, 12) = Cells(1, newrow) And Cells(oldrow, 13) = Cells(newrow, 1) Then 'date and brand
If Cells(1, 14) = Cells(newrow, 2) Then
Cells(newrow, 3).Value = Cells(oldrow, 14).Value ' m1
End If
If Cells(1, 15) = Cells(newrow + 1, 2) Then
Cells(newrow + 1, 3).Value = Cells(oldrow, 15).Value ' m2
End If
If Cells(1, 16) = Cells(newrow + 2, 2) Then
Cells(newrow + 2, 3).Value = Cells(oldrow, 16).Value ' m3
End If
If Cells(1, 17) = Cells(newrow + 3, 2) Then
Cells(newrow + 3, 3).Value = Cells(oldrow, 17).Value ' issue
End If
If Cells(1, 18) = Cells(newrow + 4, 2) Then
Cells(newrow + 4, 3).Value = Cells(oldrow, 18).Value ' repack
End If
If Cells(1, 19) = Cells(newrow + 5, 2) Then
Cells(newrow + 5, 3).Value = Cells(oldrow, 19).Value ' extra
End If
If Cells(1, 20) = Cells(newrow + 6, 2) Then
Cells(newrow + 6, 3).Value = Cells(oldrow, 20).Value ' wastage
End If
End If
Next newrow
Next oldrow
End Sub
Maybe you even don't need VBA to update the data. You can simply enter a formula =C2 into a cell to reference (and retrieve the data from) a cell.
You also can reference cells from other sheets like this =Sheet1!C2.
And you can use Functions such as IF to do more complex cases and logic.
You just cant use Cells without sheet referencing. Because excel dont know which sheet you wana to use and assuming active sheet. So you need to you ActiveSheet.cells() and switching active sheet (but its not highly recommended). Instead use sheet declaration like this
Dim myLovelySheet as worksheet
Set mylovelySheet = Sheets("yourCuteSheetname")
and then you can work with sheet like with object (you will be familiar to it from C++)
myLovelySheet.cells()
or you can perform multiple operations on sheet with construction like this
with myLovelySheet
.cells()
.cells()
'etc
end with
Basicaly your approach is almost correct, but try study more code. I can recommend this which have multiple examples with good practise