I have 2 columns with USD amounts of payments I need to compare. Data is from two different sources but they should match. Every month there is different number of payments so I dont know if next time there will be 20 or 30 of them. So I need to compare these 2 columens. What I want to do is using if function
If [n3] = [u3] Then
[q3] = "yes"
Else
[q3] = "no"
End If
and I dont know how to use loops to do this with every payment.
Function to count the number of rows with values starting from a cell (defined as a Range object)
Public Function CountRows(ByVal r As Range) As Long
If IsEmpty(r) Then
CountRows = 0
ElseIf IsEmpty(r.Offset(1, 0)) Then
CountRows = 1
Else
CountRows = r.Worksheet.Range(r, r.End(xlDown)).Rows.Count
End If
End Function
Example Usage inside the Sheet code where you want the check to happen.
Public Sub CheckPayments()
Dim rn as Range, ru as Range, rq as Range
'One price column & first value
Set rn = Range("N3")
'Otjher price column & first value
Set ru = Range("U3")
' Check result column & first value
Set rq = Range("Q3")
Dim i as Long, n as Long
' Count non-empty cells below "N3"
n = CountRows(rn)
'Loop through rows
For i = 1 to n
' Check for matching values
If rn.Cells(i,1).Value = ru.Cells(i,1).Value Then
rq.Cells(i,1).Value = "yes"
Else
rq.Cells(i,1).Value = "no"
End If
Next i
End Sub
Related
I'm working on a project and need at the moment to find the first empty cell just after text cells in a row in Excel. To clarify, let me explain to you what I'm lookng for with this screenshot
I want to write a code to return for me for like an example in the case of the 20th row the number of column of the cell E20 even if the first empty cell is A20 but like I said, i want the first empty cell juste after the last "not empty" one.
for the 21th row the result will be C21, the 22th row it will be F22 and there you go
Here's the code I wrote but for some reason it doesn't work, please help.
Function emptyCell(ws As Worksheet, ligne As Integer)
Dim m, p, n As Integer
Dim suite(700) As Integer
For k = 0 To 700
suite(k) = 0
Next
emptyCell = 0
i = 1
Do Until suite(i) = 0 And suite(i - 1) = 1
If ws.Cells(ligne, i) <> "" Then
suite(i) = 1
End If
i = i + 1
emptyCell = emptyCell + 1
Loop
End Function
Sub test()
Dim d As Integer
empty_cell = emptyCell(Sheets("tmp"), 2)
MsgBox (empty_cell)
End Sub
The logic of my code is to assign 0 for empty cells and 1 in the other caase, run a test to find the first 1-0 that's gonna appear in my array and get the column order from the order of this "1"
I know I'm not that clear cause I didnt want it to make it a long post and english is not my first language.
Thanks in advance
All if you want to get the first empty cell after the last non empty cell, why not try it like this?
Function emptyCell(ws As Worksheet, Row As Long) As Range
Set emptyCell = ws.Cells(Row, ws.Columns.Count).End(xlToLeft).Offset(, 1)
End Function
Sub Test()
Dim empty_cell As Range
Set empty_cell = emptyCell(Sheets("tmp"), 20)
MsgBox empty_cell.Address
End Sub
I am not familiar with using macro's, but I think that what I would like excel to perform is best handled with a macro. So I can use all the input you may have!
I have these headers;
ID Tag Pen Sex Weight Class Inside range
With 450 rows of data. Based on the distribution of the weight data, I have in two other columns (class and number) the number of rows I want to select within each class. The selected rows must have the value "Yes" in the column "Inside range".
I want to randomly select the rows, based on the number needed for each class, and copy these rows to a new sheet. It sums up to 30 rows in the new sheet.
I hope you have a suggestion how to complete this action!
can you try the following, you will need to add a reference to Microsoft Scripting Runtime library:
Const rowCount = 450
Public Sub copyRows()
Dim i As Integer
Dim j As Integer
Dim classes As Scripting.Dictionary
Dim source As Worksheet
Dim colNumber As Integer
Dim colClassName as Integer
Dim colInsideRange As Integer
Dim allSelected As Boolean
Dim randomRow as Integer
Dim sumRemaining as Integer
allSelected = False
Set source = Worksheets("YourWorksheetName")
colClassName = 6 'this is the column number where class names are entered. I am assuming 6
colNumber = 7 'this is the column number where number of rows to be selected are entered. I am assuming 7
colInsideRange = 8 'this is the column number where "Inside Range" values are entered. I am assuming 9
For i = 2 to rowCount + 1 'assuming you have a header row
classes(CStr(source.Cells(i, colClassName))) = CInt(source.cells(i, colNumber)
Next i
Do until allSelected
Randomize
randomRow = Int ((Rnd * 450) + 2) 'assuming you have a header row, + 1 if you don't
If classes(CStr(source.Cells(randomRow, colClassName))) = 0 Then
With classes
sumRemaining = 0
For j = 1 to .Count - 1
sumRemaining = sumRemaining + .Items(j)
If sumRemaining > 0 Then Exit For
Next j
allSelected = (sumRemaining = 0)
End With
Else
source.Cells(randomRow, colInsideRange) = "Yes"
classes(CStr(source.Cells(randomRow, colClassName))) = classes(CStr(source.Cells(randomRow, colClassName))) - 1
End If
Loop
'Enter your code to copy rows with "Inside Range" = "Yes"
End Sub
Sorry if there are some errors or typos, I wrote from my mobile phone.
Another VBA question (I'm on fire lately)
As the title says, I am trying to sum a column that can can be of a variable length and then stick that sum in cell F3, but I am running into a an "application or object defined error.
Here's my code:
Dim last As Range, sum As Variant
ActiveSheet.Range("M8").Select
Set last = Selection.End(xlDown)
With Worksheets("Data")
sum = WorksheetFunction.sum(.Range("M8:M" & last))
End With
Range("F:3") = sum
With Worksheets("Data")
.Range("F3").Value = Application.Sum(.Range(.Range("M8"), .Range("M8").End(xlDown))
End With
Using your method, last needs to be a Long to which you assign the row number.
Dim last As Long
Dim sum As Long
ActiveSheet.Range("M8").Select
last = Selection.End(xlDown).Row
With Worksheets("Data")
sum = WorksheetFunction.sum(.Range("M8:M" & last))
End With
Range("F3") = sum
You could also do it a little more efficiently, by using
last = ActiveSheet.Range("M8").End(xlDown).Row
and not using the Select.
Use this function to robustly count the non-empty cells down from a cell.
' Enumerate non-empty cells down the rows.
Public Function CountRows(ByRef r As Range) As Long
If IsEmpty(r) Then
CountRows = 0
ElseIf IsEmpty(r.Offset(1, 0)) Then
CountRows = 1
Else
CountRows = r.Worksheet.Range(r, r.End(xlDown)).Rows.Count
End If
End Function
There is a non VBA way. In cell F3 type the following:
=SUM(OFFSET($M$8,0,0,COUNTA(M:M),1))
NB - this assumes the only content of column M are the numbers you'd like to sum
I have a two dimensional table in Excel. eg.
outputproduct blending combination
**5 P1:0.6/P3:0.5**
2 P1:0.3/P2:0.7
4 P5:0.4/P2:0.7
7 P11:0.7/P7:0.4
Suppose the range of the table varies from B2:C6 (it can vary). I have to create a function, whose first job is to read this range( which would be a user defined input) and then stores the data into a 2 dimensional array such that I could use the data(integer) in the first column and the string in the second column, appropriately.
The first column is the resultant product index, while the second column is the blending products in the given ratio, which combine together to give the product in the first column.
Then there is another table:
product index current stock updated stock
**1** **10**
2 20
**3** **50**
4 15
**5** **100**
. .
. .
. .
I have to update the stock amount in this table after the data processing.
For example, on combination of product 1 with product 3 in the ratio of 6:5 (units), 1 unit of product 5 is produced. So, I have to update the amount of stock for each of the products in table 2.
Any suggestions, how to convert the range into a 2 dimensional array?
Public Function Blending_function( R1 as Range, R2 as Range)
' R2 is the range of table 2, where the updating is to be done
' R1 is first stored in to a 2 dimensional array, such that the data in the
' column 1 could be read, and the data in the column 2 could be read (of table 1).
' the integer in the column 1 of table 1 refers to the product index in table 2.
' P(i) stands for the ith product. In first row of table-1, P1 and P3 combine in the
' ratio of 6:5 to give P5. The current stock of each product is provide in table-2,
' whose range is R2(entire table 2).
' R1 is the range of table 1, from where the processing is to be done
End Function
The main hurdle for me is to convert the range R1 (Table-1) into a 2 dimensional array. And then look from that array, the index of the output product, and locate that product in table-2 for updating the stock level.
Here is an example on how to work with 2D array. The function will break up the blending combination and extract the values that you want so that you can use those.
Sub Sample()
Dim Rng1 As Range, Rng2 As Range
On Error Resume Next
Set Rng1 = Application.InputBox("Please select the Table1 Range", Type:=8)
On Error GoTo 0
If Rng1.Columns.Count <> 2 Then
MsgBox "Please select a range which is 2 columns wide"
Exit Sub
End If
On Error Resume Next
Set Rng2 = Application.InputBox("Please select the Table2 Range", Type:=8)
On Error GoTo 0
If Rng2.Columns.Count <> 3 Then
MsgBox "Please select a range which is 3 columns wide"
Exit Sub
End If
Blending_function Rng1, Rng2
End Sub
Public Function Blending_function(R1 As Range, R2 As Range)
Dim MyAr1 As Variant, MyAr2 As Variant
Dim i As Long
Dim blndCom As String, OutputPrd As String
Dim ArP1() As String, ArP2() As String, tmpAr() As String
MyAr1 = R1
For i = 2 To UBound(MyAr1, 1)
OutputPrd = MyAr1(i, 1)
blndCom = MyAr1(i, 2)
tmpAr = Split(blndCom, "/")
ArP1 = Split(tmpAr(0), ":")
ArP2 = Split(tmpAr(1), ":")
Debug.Print OutputPrd
Debug.Print Trim(ArP1(0))
Debug.Print ArP1(1)
Debug.Print ArP2(0)
Debug.Print ArP2(1)
Debug.Print "-------"
Next
End Function
SNAPSHOT
Once you have these values you can use .Find to search for the product index in the range R2 and then use .Offset to enter your formula.
I'm not sure if I understood the entire story, but this is what a function to return
a multidimensional array could look like:
Public Sub Main_Sub()
Dim vArray_R1() As Variant
Dim oRange As Range
Set oRange = ThisWorkbook.Sheets(1).Range("A1:B5")
vArray_R1 = Blending_function(oRange)
'You do the same for The second array.
set oRange = nothing
End Sub
Public Function Blending_function(R1 As Range)
Dim iRange_Cols As Integer
Dim iRange_Rows As Integer
iRange_Cols = R1.Columns.Count
iRange_Rows = R1.Rows.Count
'Set size of the array (an existing array would be cleared)
ReDim vArray(1 To iRange_Rows, 1 To iRange_Cols)
vArray = R1
Blending_function = vArray
End Function
A second option could be to declare the function to return a boolean and since arguments are standard sent byRef; you can declare the ranges and arrays in the main sub only, and convert them both at the same time in the function. I wouldn't choose for this option, because you wouldn't be able to re-use the function afterwards to convert other ranges into arrays.
Supplementary info:
This technique works both ways. You can afterwards define a range and do:
set oRange = vArray
This on the condition that the Range has the same size as the array.
row = 2
column = "B"
Do While Len(Range(column & row).Formula) > 0
' repeat until first empty cell in column 'column'(user input)
' read (column, row) and (column+1, row) value
Cells(row, column).Value
Cells(row, column+1).value
' store in Array
Loop
Is there a way to merge multiple records then display only the highest value for each column? Example: A2:A25=names, B2=Grade1, C2=Grade2...etc.
First I removed duplicates in case there are exact duplicates. Then I sort on Name.
Can something be added to this code, based on column A-names, to display each name once with the highest value from each column?
=IF(B2="","Empty",IF(B2="High","High",IF(B2="Med","Med",IF(B2="Low","Low",""))))
Data Example
A1:name B1:Grade1 C1:Grade2...etc
A2:Joe B2:High C3:Low
A3:Joe B3:Med C3:High
A4:Dan B4:Low C4:Med
A5:Dan B5:Low C5:Low
__Results: Joe Grade1=high Grade2=high, Dan: Grade1=Low Grade2=Med
Record an Excel macro. Select first column. Click advanced filter.Choose copy to location and select a new column say X. Enable unique filter. Now click Ok. Now look at vba source to get the code to get unique elements in a column. Now assign Low as 0, Med as 1, High as 2 . loop through the rows and find the maximum grade1 , maximum grade2 etc corresponding to each element in column X and populate columns Y,Z etc. As and when you find a new maximum replace the existing. Now you will have the required data in columns X,Y,Z. Loop through them again and display in the format what you needed.
Decided to try VBA code for this one. It's a bit bruitish, but gets the job done.
Took a shortcut and made columns b and c numbers rather than strings. You could do a lookup function on the spreadsheet to make that conversion, or add an extra check in the code.
Sub find_high_values()
' subroutine to find max values of columns b and c against names
' assumes for simplicity that there are no more than 10 rows
' assumes values being checked to be numbers, if they are strings, additional loops would need to be done
Dim sName(10) As String, lBval(10) As Long, lCval(10) As Long 'arrays for original list
Dim iCountN As Integer, iUnique As Integer, iUniqueCount As Integer 'counters
Dim bUnique As Boolean
Dim rStart As Range, rOutput As Range 'ranges on worksheet
Dim lBmax(10) As Long, lCmax(10) As Long, sUniqueName(10) As String 'output arrays
Set rStart = ActiveSheet.Range("d6") 'Cell immediately above the first name in list
Set rOutput = ActiveSheet.Range("j6") 'cell reference for max value list
iUniqueCount = 1
For iCountN = 1 To 10 'set max counters to a min value
lBmax(iCountN) = 0
lCmax(iCountN) = 0
Next
For iCountN = 1 To 10 'step through each original row
sName(iCountN) = rStart.Offset(iCountN, 0).Value
lBval(iCountN) = rStart.Offset(iCountN, 1).Value
lCval(iCountN) = rStart.Offset(iCountN, 2).Value
bUnique = True 'Starter value, assume the name to be unique, changes to false if already in list
For iUnique = 1 To iCountN 'loop to check if it is a new name
If sUniqueName(iUnique) = sName(iCountN) Then bUnique = False
Next
If bUnique Then 'if new name, add to list of names
sUniqueName(iUniqueCount) = sName(iCountN)
iUniqueCount = iUniqueCount + 1
End If
Next
iUniqueCount = iUniqueCount - 1 'make the count back to total number of names found
For iUnique = 1 To iUniqueCount 'loop through names
For iCountN = 1 To 10 'loop through all values
If sName(iCountN) = sUniqueName(iUnique) Then
If lBval(iCountN) > lBmax(iUnique) Then lBmax(iUnique) = lBval(iCountN)
If lCval(iCountN) > lCmax(iUnique) Then lCmax(iUnique) = lCval(iCountN)
End If
Next
Next
'output section
rStart.Resize(1, 3).Select
Selection.Copy
rOutput.PasteSpecial xlPasteValues
For iUnique = 1 To iUniqueCount
rOutput.Offset(iUnique, 0).Value = sUniqueName(iUnique)
rOutput.Offset(iUnique, 1).Value = lBmax(iUnique)
rOutput.Offset(iUnique, 2).Value = lCmax(iUnique)
Next
End Sub