VBA Loops Using Subtraction - vba

I'm trying to develop a 'for loop' macro that will calculate the duration between two dates in adjacent columns.
My current code:
Sub Enter_Formulas()
FinalRow = Cells(Rows.Count, 2).End(xlUp).Row 'Counts # of rows in the data set
For x = 5 To FinalRow
Cells(x, 10).Formula = "=I5-H5"
End Sub
This will accurately return the difference between I5 & H5, but I want the formula to flow down the columns. (i.e. the next row should calculate I6 - H6 and then I7-I8.. and so on and so forth)
Any advice would be greatly appreciated!!

I recommend not using a loop, you can autofill the whole range in one go:
Sub Enter_Formulas()
FinalRow = Cells(Rows.Count, 2).End(xlUp).Row 'Counts # of rows in the data set
Range(Cells(5, 10).address, Cells(FinalRow, 10).address).Formula = "=I5-H5"
End Sub
However, if you must use a loop then try this:
For x = 5 to FinalRow
Cells(x,10).Formula = "=" & Cells(x,9).Address & "-" & Cells(x,8).Address
Next x
That way by concatenating cell addresses relying on x, they will also increment by one row each time.

You can also do this, if you must use a loop (and I usually would not), by using the R1C1 form of addressing:
For X = 5 To FinalRow
Cells(X, 10).FormulaR1C1 = "=RC[-1]-RC[-2]"
Next X
And if your worksheet is using the A1 reference style, this will get translated appropriately.

Related

Test-If not empty, prompt with InputBox for multiplier

This is what I'm going for, but I'm pretty green when it comes to loops:
If (G1<>"", InputBox for a multiplier for range G2:G's LastRow,"")
Loop through column BZ1 (or preferably, the last column)
Or:
G1:BZ1 each contain the name of an order set. I need to manually enter the number of times each order set will be used. D2:D1001 are the number of times an item occurs in each set. I need to multiply D2:D1001 by the input box's number and enter that result for each item into G2:G1001.
I have multiple order sets and need to multiple each one by a different number of stores every time that this macro will be run. Order sets are in the columns, items are in the rows.
This should do the trick - just change that Sheet1 to whatever your sheet's name is.
So first we get the last column of data to use for our first loop (by getting the value of lastcol), then we start looping through the columns. We assign a value to multiplier through the InputBox, and after that we loop through every cell in the column and multiply it by the number you entered. Then we move on to the next column until we've run out of data.
I've updated the text in the InputBox to display the header text for each column each time.
Sub Test()
Dim sht As Worksheet, lastcol As Long, lastrow As Long, multiplier As Integer
Set sht = ThisWorkbook.Worksheets("Sheet1")
lastcol = sht.Cells(1, sht.Columns.Count).End(xlToLeft).Column
For i = 7 To lastcol
If Cells(1, i) <> vbNullString Then
multiplier = InputBox("Number of stores using set " & Cells(1, i) & ".")
lastrow = sht.Cells(sht.Rows.Count, 4).End(xlUp).Row
For j = 2 To lastrow
On Error Resume Next
Cells(j, i).Value = Cells(j, 4).Value * multiplier
On Error GoTo 0
Next j
End If
Next i
End Sub

Average with If condition

I want to calculate the average of the cells in column E, only for the rows that have 0 in column I. It needs an if condition and then perform the standard average line of code.. I am providing the code I have written to calculate the average for all cells in column E. This code needs editing to include this if condtion. If someone knows what to add to have this if condition I would appreciate it !
Also, I am providing a screenshot
lastrow = Cells(Rows.Count, "D").End(xlUp).Row
Range("C1").Formula = "=AVERAGE(E2:E" & lastrow & ")"
formula:
=AVERAGEIF(I:I,0,E:E)
or in vba:
WorksheetFunction.AverageIf(Range("I:I"), 0, Range("E:E"))
As far as I know you cannot do this with an excel function unless you make it an array function. Array functions are powerful but can be very slow at calculating. Here is a VBA solution using a VBA collection.
The answer you selected is definitely a more efficient way of getting the answer. But this code may be useful if you are wanting to manipulate those numbers in other ways since it puts them into a collection.
I made a VBA collection and added to it all values in E that corresponded to 0 values in D. Then I summed it into a variable called f and then divided it by the count of the collection. Then dropped it in the range you wanted.
Sub test()
Dim a As Collection
Dim lastrow As Integer
Set a = New Collection
lastrow = Cells(Rows.Count, "D").End(xlUp).Row
For x = 1 To lastrow
If Cells(x, 9) = 0 Then
y = Cells(x, 5).Value
a.Add (y)
End If
Next x
For Z = 1 To a.Count
f = a.Item(Z) + f
Next Z
Range("C1").Value = (f / a.Count)
End Sub

Faster method to compare two columns from 2 different workbooks

So I have some code using for loops currently doing this and it takes roughly 6 minutes to run...
I have many sheets showing the same columns with some different data.
One column comes in either a named form or a numerical form (Depending on how a user input it to a completely separate database).
Another database contains 2 columns: one being the numerical form of data while the other is named.
My database currently compares my "name" column if numerical with the numerical column in this other database and when it finds a match it changes my "name" cell to match the corresponding name cell in the other database.
Is there any faster way to do this than using for loops?
I have to replicate the code around 12 times for different sheets to do the same task.
As previously stated, overall to run across all 12 its taking around 6 minutes
Sub 6mincode()
Workbooks("1").Activate
N = Workbooks("1").Sheets("Data").Cells(Rows.Count, "B").End(xlUp).Row
N2 = Workbooks("2").Sheets("Data Sheet").Cells(Rows.Count, "B").End(xlUp).Row
For I = 2 To N
If (WorksheetFunction.IsNumber(Sheets("Data").Cells(I, "B").Value)) = True Then
For zz = 8 To N2
If StrComp(Sheets("Data").Cells(I, "B").Value, Workbooks("2").Sheets("Data Sheet").Cells(zz, "B").Value) = 0 Then
Workbooks("1").Sheets("Data").Cells(I, "B").Value = Workbooks("2").Sheets("Data Sheet").Cells(zz, "C").Value
End If
Next zz
End If
Next I
End Sub
You can save the second loop and use Application.Match instead, it will save you a lot of time.
See code below, explanations inside the code's comments:
Option Explicit
Sub Sixmincode()
Dim N As Long, N2 As Long, I As Long
Dim Rng As Range, MatchRow
With Workbooks("1").Sheets("Data")
N = .Cells(.Rows.Count, "B").End(xlUp).Row
End With
With Workbooks("2").Sheets("Data Sheet")
N2 = .Cells(.Rows.Count, "B").End(xlUp).Row ' get last row with data in column B
' set the Range to Match with
Set Rng = .Range("B8:B" & N2)
End With
With Workbooks("1").Sheets("Data")
For I = 2 To N
If IsNumeric(.Cells(I, "B").Value) Then ' use IsNumeric
' use Application.Match, if Not IsError means there is a match found in the second workbook
If Not IsError(Application.Match(.Cells(I, "B").Value, Rng, 0)) Then
MatchRow = Application.Match(.Cells(I, "B").Value, Rng, 0)
.Cells(I, "B").Value = Workbooks("2").Sheets("Data Sheet").Cells(MatchRow, "C").Value
End If
End If
Next I
End With
End Sub

How to write an "If(And" code with unknown number of cells in column?

Is there a way to check if all cells in a column are less than 1? If there were only a few cells, with the number of cells known up front, I would use the code below.
However, from case to case the number of cells in column A will vary. I need to know if any of the cells in column A is less than 1.
If there is one (or more) cell containing a value less than 1, I need a cell (A1 for example) to show NOT OK. If only ALL the cells' values are greater than 1, I need the cell (A1 for example) to show OK.
If all cells in column A have values greater than 1, I want to continue and check column B for the same thing. Otherwise I want to save and close the workbook and continue with next open workbook...also with vba code.
Any suggestions on how to write this in VBA? Maybe there is way other than If(AND...)?
Sub IfAnd()
IF(AND(A5>1,A4>1,A3>1,A2>1),"OK", "NOT OK")
End Sub
This code will solve all your columns and insert the data in THE FIRST ROW OF EACH COLUMN
Sub Problems()
Dim CurCol, LastRow, LastCol as Long
LastCol = Cells(2, Columns.Count).End(xlToLeft).Column
For CurCol = 1 to LastCol
LastRow = Cells(Rows.Count, CurCol).End(xlUp).Row
If WorksheetFunction.Min(Range(Cells(2, CurCol), Cells(LastRow, CurCol))) < 1 Then
Cells(1, CurCol).Value = "NOT OK"
Else
Cells(1, CurCol).Value = "OK"
End If
Next CurCol
End Sub
Here is a way of doing it without any worksheet functions.
Sub test()
Dim ws As Worksheet
Dim ce As Range
Dim sr, lr, lc As Integer
'worksheet you are working with
Set ws = ThisWorkbook.Sheets(1)
'column you are searching
Set ce = ws.Cells(ws.Rows.Count, 1)
'start row set to 2 so row 1 will contain output
Let sr = 2
'search only the last row
Let lr = ce.End(xlUp).Row
Let lc = ws.Cells(sr, ws.Columns.Count).End(xlToLeft).Column
For c = 1 To lc
For r = sr To lr
If ws.Cells(r, c).Value < 1 Then
ws.Cells(1, c).Value = "NOT OK"
GoTo NotOK
End If
Next r
ws.Cells(1, c).Value = "OK"
NotOK:
Set ce = ws.Cells(ws.Rows.Count, c+1)
Let lr = ce.End(xlUp).Row
Next c
End Sub
This should be faster and more efficient for large data sets. Especially if it is sorted smallest to largest.
Here you are:
=IF(MAX(A:A)<1)
If VBA is not required, here is a worksheet formula that should do the job, and will also ignore blanks and non-numeric entries:
This formula must be array-entered:
=IF(ISNUMBER(MATCH(TRUE,IF(ISNUMBER($A:$A),$A:$A)<1,0)),"NOT OK","OK")
If this formula must be located in A1, change the range references from $A:$A to $A$2:$A$1000 where 1000 represents the highest conceivable row number for the data.
To array-enter a formula, after entering
the formula into the cell or formula bar, hold down
< ctrl-shift > while hitting < enter >. If you did this
correctly, Excel will place braces {...} around the formula.

Excel Macro: If Column B contains 12 digits then column C equals 3?

So, I'm trying to figure out how to write an Excel macro to populate Column C with either 3 or a 4 depending on the amount of numbers contained in Column B.
I have searched up and down for the right wording to this, but I keep coming up short.
Basically, I need the macro to look at the number of digits in Column B. If there are 12 digits then the number is a UPC, and if there are 13 then the number is an EAN. I then need the macro to populate Column C with a 3 for UPCs and a 4 for EANs. This needs to be for the entire range of rows in the spreadsheet.
Does anyone have any ideas? Thanks a lot in advance!
You don't need to use a dirty old loop, try this (much faster if you have lots of rows):
Sub HTH()
With Sheet1.Range("B1", Cells(Rows.Count, "B").End(xlUp)).Offset(, 1)
.Formula = "=IF(LEN(TRIM(B1))=12,3,IF(LEN(TRIM(B1))=13,4,""""))"
.Value = .Value
End With
End Sub
Or use a user defined function, which has the advantage of changing when the data in column B is updated.
Better yet just use a formula, you don't really need VBA.
Alternative VBA Method (looping the fast way):
Sub HTH()
Dim vArray As Variant
Dim lCnt As Long
With Range("B1", Cells(Rows.Count, "B").End(xlUp))
vArray = .Value
For lCnt = 1 To UBound(vArray, 1)
Select Case Len(Trim(vArray(lCnt, 1)))
Case 12: vArray(lCnt, 1) = 3
Case 13: vArray(lCnt, 1) = 4
Case Else:
End Select
Next lCnt
.Offset(, 1).Value = vArray
End With
End Sub
You can get the length of a cell's value by using Len() like this Len(Range("A1")) for example.
Now you just need to loop through your column and look at each value. If you look for the last used cell and loop only through that range your loop will be faster.
Here is how I would do it:
sub TestUPC()
With ActiveSheet
LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
End With
Dim rRng As Range
Set rRng = Range("B1:B" & LastRow)
For Each cell In rRng.Cells
If Len(Trim(cell))=12 then
cell.Offset(0, 1).Value = 3
ElseIf Len(Trim(cell))=13 then
cell.Offset(0, 1).Value = 4
End If
Next
End Sub
An in cell equation could look like this:
=IF(LEN(B1)=12,3,IF(LEN(B1)=13,4," "))
As suggested in the comments you might want to test for spaces depending on your data:
=IF(LEN(TRIM(A1))=12,3,IF(LEN(TRIM(A1))=13,4," "))