For a project I'm looking to compare Col.A and Col.A. I've added the numbers using code but cant work out how to compare the two in Col. C for example if Col.A and Col B match I want Col.C to say "yes" or "No". also if I wanted to do this with Codes and not numbers would I add just string and not int? Or what if I wanted to match dates. Any help be great as I'm just getting back into VB
The code I've worked on is below
Private Sub CommandButton1_Click()
Cells.ClearContents
Range("A1") = "Column A"
Range("B1") = "Column B"
Range("C1") = "Column C"
Dim i As Boolean
For i = 2 To 25
Range("A" & i) = Int((10 - 2 + 1) * Rnd + 2)
If i < 26 Then
Range("B" & Range("B" & Rows.Count).End(xlUp).Row + 1) = _
Int((10 - 2 + 1) * Rnd + 2)
End If
Next i
End Sub
Can you use Excel's built in exact function?
FormulaR1C1 = "=EXACT(RC[-2],RC[-1])"
The function will return a value of TRUE or FALSE
Before the snippet FormulaR1C1 you'll want to input the destination cell for the formula
The RC[-2],[RC-1] says perform the "EXACT" calculation on the cells: 1 cell to the left and 2 cells to the left
Related
I have three scenarios of input range ("A1&C3") it can be F1&H3/ J1&L3 /N1&P3.
When I change value of A1&C3 to one of three scenarios, the value in A10&C12 also change (because it contains formula).
I don't want to copy each output result ("A10& C12") to another sheet of three scenarios manually.
I tried to use VBA to make it automatically (3 outputs in 3 new sheets).
Option Explicit
Sub Save()
If Worksheets("Sheet1").Range("A1&C3").Value = Worksheets("Sheet1").Range("F1&H3").Value Then
Worksheets("Sheet1").Range("A1&C3").Copy
Worksheets("BC").Range("A1&C3").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Exit Sub
ElseIf Worksheets("Sheet1").Range("A1&C3").Value = Worksheets("Sheet1").Range("J1&L3").Value Then
Worksheets("Sheet1").Range("A1&C3").Copy
Worksheets("UB").Range("A1&C3").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Exit Sub
ElseIf Worksheets("Sheet1").Range("A1&C3").Value = Worksheetss("Sheet1").Range("N1&P3").Value Then
Worksheets("Sheet1").Range("A1&C3").Copy
Worksheets("LB").Range("A1&C3").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
End If
End Sub
Your arrays are wrongly notated within that Range field. Should be A1:C3 and likewise throughout your ranges.
You can't use "Value" as an array comparison in this method. Unless you convert the entire array to a single string and then compare it, its likely going to require some for loops to iterate thru the arrays... that's just a lot of ugly code.
Understanding that when you select a A1:C3, you're creating a you're creating an indexed array or "variant" as they're called in the "land of VB"... needless to say, here's some tweaks that just iterate throughout each of the cells and perform comparative operations for each column/row value and then determine if there's a reasonable match.
Or you could just concatenate it as one big string like this...
For col = 0 To 2 'For Each Column (3 columns)
For Row = 0 To 2 'For each row (3 rows)
'These variable declarations are simply going to append the "Alphabetical" character representation
Z = Chr(Delta + col) & (Row + 1)
A = Chr(Comp1 + col) & (Row + 1)
B = Chr(Comp2 + col) & (Row + 1)
C = Chr(Comp3 + col) & (Row + 1)
1starraystr = 1starraystr & Worksheets("Sheet1").Range(Z).Value
2ndarraystr = 2ndarraystr & Worksheets("Sheet1").Range(A).Value
3ndarraystr = 2ndarraystr & Worksheets("Sheet1").Range(B).Value
4ndarraystr = 2ndarraystr & Worksheets("Sheet1").Range(C).Value
Next
Next
if 1starraystr = 2ndarraystr then... ' you get the idea.
You could compare strings like that afterwards. It's cheeky but could be cleaner than counting a variable upwards. Up to you.. I'll present both options.
Sub Save()
'Set the numeric DEC value for each letter to easily iterate thru alphabet / array comparison.
Const Delta = 65, Comp1 = 70, Comp2 = 74, Comp3 = 78
'Set Counters to 0 to just use a simple counter to validate accuracy of 3 matches.
C1 = 0: C2 = 0: C3 = 0
For col = 0 To 2 'For Each Column (3 columns)
For Row = 0 To 2 'For each row (3 rows)
'These variable declarations are simply going to append the "Alphabetical" character representation
Z = Chr(Delta + col) & (Row + 1)
A = Chr(Comp1 + col) & (Row + 1)
B = Chr(Comp2 + col) & (Row + 1)
C = Chr(Comp3 + col) & (Row + 1)
'Debug.Print Z & vbTab & A & vbTab & B & vbTab & C
If Worksheets("Sheet1").Range(Z).Value = Worksheets("Sheet1").Range(A).Value Then C1 = C1 + 1 ': Debug.Print C1
If Worksheets("Sheet1").Range(Z).Value = Worksheets("Sheet1").Range(B).Value Then C2 = C2 + 1 ': Debug.Print C2
If Worksheets("Sheet1").Range(Z).Value = Worksheets("Sheet1").Range(C).Value Then C3 = C3 + 1 ': Debug.Print C3
Next
Next
'Debug.Print "C1 Count: " & C1
'Debug.Print "C2 Count: " & C2
'Debug.Print "C3 Count: " & C3
If C1 <= 9 Then
Worksheets("Sheet1").Range("A1:C3").Copy
Worksheets("BC").Range("A1:C3").PasteSpecial Paste:=xlPasteValues
'Debug.Print "Copied Cells to BC"
ElseIf C2 <= 9 Then
Worksheets("Sheet1").Range("A1:C3").Copy
Worksheets("UB").Range("A1:C3").PasteSpecial Paste:=xlPasteValues
'Debug.Print "Copied Cells to UB"
ElseIf C3 <= 9 Then
Worksheets("Sheet1").Range("A1:C3").Copy
Worksheets("LB").Range("A1:C3").PasteSpecial Paste:=xlPasteValues
'Debug.Print "Copied Cells to LB"
End If
Application.CutCopyMode = False
End Sub
In Excel, I have many products with different sizes listed in columns, such that the sizes "10x10 cm", "11x11 cm" and "15x15 cm" belongs to Product A, etc.
In some other cells, I am selecting a product (either Product A, Product B, or Product C) and a size.
I want, for each of the other products, to determine which size is closest to the selected product:
I don't know how to solve this. One solution might be to remove all non-numeric characters from the strings and add the two values on each side of the "x" and then select the size with the lowest absolute difference from the sum of the selected size.
But I guess it would be easier to do a mapping and use a VLOOKUP to choose the first found size in a given column.
However, the problem is that I do not only have 3 products with a few different sizes, but rather 15 different products with 10 different sizes, so I don't know how to do a mapping in a clever way.
1) Creating a lookup table with the values extracted for each product,
Source sheet:
Code:
Sub lookup()
Dim i As Long, j As Long, prod As Integer, str As String
prod = InputBox("Enter Number of Products")
Sheets.Add.Name = "LookupSheet"
j = 1
For i = 1 To prod
Columns(i).Copy Sheets("LookupSheet").Cells(1, j)
j = j + 2
Next i
For j = 1 To prod * 2 Step 2
For i = 2 To Sheets("LookupSheet").Cells(Rows.Count, j).End(xlUp).Row
str = Replace(Replace(Sheets("LookupSheet").Cells(i, j), " ", ""), "cm", "")
Sheets("LookupSheet").Cells(i, j + 1) = Left(str, InStr(str, "x") - 1) _
* Mid(str, InStr(str, "x") + 1, 999)
Next i
Next j
End Sub
This simple code creates a lookup sheet with the corresponding values. The code ignores any spaces present between the texts.
LookupSheet:
Since you have 15 different products, run this macro to extract the lookup data. This should be a one time activity unless you have additional products.
2) Assuming you enter the product and dimensions to F5 and F6, i would suggest you to data validation with dropdowns to select from the list,
3) Using a worksheet_change event, detect for changes in F5 and F6,
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim str As String, result As Integer, i As Long
'F5 and F6 contains Product and Size repectively
If (Target.Address = "$F$5" Or Target.Address = "$F$6") _
And Range("F5") <> "" And Range("F6") <> "" Then
str = Replace(Replace(Range("F6"), " ", ""), "cm", "")
result = Left(str, InStr(str, "x") - 1) * Mid(str, InStr(str, "x") + 1, 999)
j = 8
For i = 1 To Cells(1, Columns.Count).End(xlToLeft).Column
If Cells(1, i) <> Range("F5") Then
Range("E" & j) = Cells(1, i)
j = j + 1
End If
Next i
End If
End Sub
This code automatically populated the rest of the product types in the column E,
4) The variable result would contain the product/area of the value that you provide in F6. The only task pending would be to loop through the lookup sheet to find the nearest match. The Algorithm is below,
Algorithm:
Compare cell F5 with the data in row 1 of lookup sheet (need to loop)
If they are equal, ignore and move to next value. If not, need to loop the immediate next column to find the next match, and populate the result in the corresponding cell in source sheet.
Algorithm for column wise looping is below,
Steps:
diff = cell.value - result
if diff < 0 then multiply diff by -1
loop:
nextdiff = nextcell.value - result (multiply by -1 if negative)
if nextdiff < diff then
diff = nextdiff
end if
end loop:
The cell value with the least difference would be your best match for that particular product type.
Bit lengthier explanation, hope this helps.
I have wbk1.worksheet(1) and wbk2.worksheet(1).
wbk1.worksheet(1) has a list of values in column A
wbk2.worksheet(2) has the same list of values that may occur multiple times in column A with a number value in the offset(0,1) cell.
I need to do an index or match to find all of values in wbk2 and sum all of the offset(0,1) values. Then take that sum and put it in the offset(0,1) cell in wbk1.worksheets(1).
Example:
Workbook 1, sheet 1
Column A Column B
value 1
value 2
value 3
Workbook 2, sheet 1
Column A Column B
value 1 15
value 2 2
value 1 3
value 1 12
End Result:
Workbook 1, sheet 1
Column A Column B
value 1 30
value 2 2
value 3 0
I've tried doing a for each loop, but I'm still a noob to vb, so clearly not doing something right:
For Each x In rngWbk1
Set cellrngwbk2 = wbk2.Worksheets(1).Cells.Find(What:=x, LookIn:=xlValues)
If Not cellrngwbk2 Is Nothing Then
For Each y In rngwbk1
If y = cellrngwbk2 Then
total = total + cellrngwbk2.Offset(0, 1).Value
Else
End If
Next y
x.Offset(0, 1).Value = total
total = 0 'resets total value for next x value
Else
End If
next x
If VBA is not a requirement, a simple =SUMIF() statement has the same effect.
The function would look something like this:
=SUMIF([Wbk2.xlsx]Sheet1!A2:A5,Table1[[#This Row],[ID]],[Wbk2.xlsx]Sheet1!B2:B5)
There is more efficient way. You can use SUMIF formula to calculate values and then rewrite formula with result values. If rngWbk1 corresponds to the values in column A in wbk1.worksheets(1), you can use following code:
Dim frm As String
Dim startCell As String
startCell = Replace(rngWbk1.Cells(1, 1).Offset(0, -1).Address, "$", "")
frm = "=SUMIF('[" & wbk2.Name & "]" & wbk2.Worksheets(1).Name & "'!A:A," & startCell & ", '[" & wbk2.Name & "]" & wbk2.Worksheets(1).Name & "'!B:B)"
With rngWbk1.Offset(0, 1)
.Formula = frm
.Calculate
.Value = .Value
End With
If rngWbk1 doesn't correspond values in column A, you need to adjust startCell in example to startCell = "A2" and change With rngWbk1.Offset(0, 1) to sth like With wbk1.Worksheets(1).Range("B1:B100")
This question already has answers here:
Closed 10 years ago.
Possible Duplicate:
VBA function to convert column number to letter?
I need to display a msgbox that shows the last used column.
Right now the columns numeric value is displayed but can it be converted into its alpha character equivalent?
Ex. column 5 = column E.
Thanks
I managed to get 2 methods. One relies on the excel Cells, so it fails if you use an invalid column:
Function NumToLetter(q As Long) As String
Dim Add As String
'Ignore error so it fails on an invalid cell
On Error Resume Next
Add = Cells(1, q).Address
If Len(Add) Then
NumToLetter = Mid(Add, 2, InStr(2, Add, "$") - 2)
Else
NumToLetter = "Invalid Cell"
End If
End Function
the other uses base 26, and is only limited bu the maximum value for long:
Function Num2Letter(q As Long) As String
Dim r As Long
While q > 0
r = q Mod 26
If r = 0 Then r = 26 ' needed for column Z
Num2Letter = Chr(64 + r) & Num2Letter
q = Int(q / 26) + (r = 26) ' fix for column Z
Wend
End Function
to test these values with a messagebox:
msgbox "Column 2445 is " & NumToLetter(2445) & " or " Num2Letter(2445)
Column 2445 is CPA or CPA
msgbox "Column 42445 is " & NumToLetter(42445) & " or " Num2Letter(42445)
Column 42445 is Invalid Cell or BJTM
msgbox "Column -1 is " & NumToLetter(-1) & " or " Num2Letter(-1)
Column -1 is Invalid Cell or
This works for columns A through ZZ (as pointed out in the comments by Sean Cheshire):
Function ColLetter(ColNumber As Integer) As String
ColLetter = Left(Cells(1, ColNumber).Address(False, False), 1 - (ColNumber > 26))
End Function
To use: MsgBox ColLetter(oRangeObject.Column)
I have data in (Sheet4) columns A to I:
I'm trying to compare data for all rows (Only on column A and B) to see if any of the rows is duplicated, if it is: excel should highlight both rows.
Example:
A B C......I
s 1 x
s 3 w
e 5 q
s 1 o
Row 1 and 4 should be highlighted as values are the same for column A and B.
I shouldn't modify the sheet (no modification to the columns or rows should be done to the sheet), and the number of rows is not always known (not the same for all files).
Is there an easy way (using macros) to do this???
This is an attempt I have tried, but it is increasing my file to 7MB!!!!! I'm sure there should be an easier way to compare rows for an unknown number of rows and just highlight the dupllicates if they exist:
Public Sub duplicate()
Dim errorsCount As Integer
Dim lastrow As Integer
Dim lastrow10 As Integer
errorsCount = 0
lastrow = Sheet4.Cells(Rows.Count, "A").End(xlUp).Row 'is the row number of the last non-blank cell in the specified column
lastrow10 = lastrow
Sheet10.Range("B1:B" & lastrow10).Value = Sheet4.Range("A1:A" & lastrow).Value
Set compareRange = Sheet10.Range(column + "2:" & Sheet10.Range(column + "2").End(xlDown).Address)
For Each a In Sheet10.Range(column + "2:" & Sheet10.Range(column + "2").End(xlDown).Address)
c = a.Value
If c <> Null Or c <> "" Then
If name = "testing" Then
If WorksheetFunction.CountIf(compareRange, c) > 1 Then
a.Interior.ColorIndex = 3
errorsCount = errorsCount + 1
End If
End If
End If
Next a
If errorsCount > 0 Then
MsgBox "Found " + CStr(errorsCount) + " errors"
Else
MsgBox " No errors found."
End If
End Sub
Silly answer to you.
J1 or just duplicate sheet.
J1 =CONCATENATE(A1,"#",B1) > drag down > J:J > conditional format > highlight cells rules > duplicate values.
(* replace the # to any string which you think not possible in the original A:A and B:B.)
I do this all the time.
To collect all duplicates just SORT with color.