How to highlight duplicates rows based on more than 30 columns? - excel

I am trying to highlight duplicate rows by Excel VBA code but I'm receiving a "'Range' of Object _Global' failed" error and I'm hoping someone can help as to why.
Sub Duplicate_Row()
Dim x As Integer
Dim Y As Integer
Dim Z As Integer
x = 2
Y = x + 1
Z = 2
Do While Range("A:AA" & Y) <> ""
Z = Z + 1
Do While Range("A:AA" & Y) <> ""
If Range("A:AA" & x) = Range("A:AA" & Y) And Range("A:AA" & Y).Interior.ColorIndex = xlColorIndexNone Then
Range("A:AA" & x).Activate
Selection.End(xlToLeft).Select
Range("A" & x).Select
Range(Selection, Selection.End(xlToRight)).Select
'Selection.Interior.Color = vbYellow
Selection.Interior.ColorIndex = Z
Range("A" & Y).Select
Range(Selection, Selection.End(xlToRight)).Select
'Selection.Interior.Color = vbYellow
Selection.Interior.ColorIndex = Z
End If
Y = Y + 1
Loop
x = x + 1
Y = x + 1
Loop
MsgBox "Done"
End Sub
How to highlight duplicates in rows with msgbox ? I also want a msgbox for duplicate rows and highlight only those rows in which all the details are duplicate.

As my late father used to say "When you can do something the difficult way, then why do it the easy way?" and this is exactly what I see when reading your question. :-)
I have made a small Excel file, highlighting duplicates, using conditional formatting, as you can see in this screenshot:
(It's all about column "A", the others are just there for explanatory reasons: "B" contains the formula results, "C" contains the =FormulaText(Bn) formula.)
The formula this is based on, is: =COUNTIF($A$1:A1,A1)-1.
Some explanation: this formula (you can see the results in the second column) counts the amount of times that An (which is what you get by dragging down A1) is present in the range A1:An (the first cell A1 is fixed because of the dollar-signs in the formula), minus one (in order not to count the cell value itself. As a result, when the value gets found before (a duplicate), the value gets 1 or higher, and when the value does not get found before, you get a zero. Conditional formatting can be based on formulae: TRUE or non-values get highlighted.

Related

How to solve type mismatch (Run Error 13) for Date in VBA?

I am writing a VBA code in my excel. I have employees date of birth on Row F. Now, using VBA, I want phrase called "Happy Birthday" on column G for those employees who have birthdays. My table starts from row 6 to row 50. I wrote the following code but it always gives error in Month(Range("f" & y)). The month function gives me error. If, for example, I only write Range("f" & y), it will work fine. This means the Date of birth on column F isn't being recognized as DATE in my VBA (they are in date format in excel). There is a mismatch for sure. Can someone please help me how to fix this issue (using for next function as shown below)?>
Sheets("Employees").Select
For y = 6 To 50
If Month(VBA.Date) = Month(Range("f" & y)) Then
Range("g" & y).Value = "HBD"
Else
Range("g" & y).Value = "No hbd"
End If
Next y
Note: A). I am looking at the month of date of birth only for wishing happy birthday and I am not looking at day. B). I want message called HBD or NO HBD to be posted on column G for each employee based on their DOB given on Column F .
With a formula I think you should be able to do it with =IF(MONTH(TODAY())=MONTH(F6),"HBD","No HBD").
For a VBA solution use:
Sub Test()
Dim y As Long
With ThisWorkbook.Worksheets("Employees")
For y = 6 To .Cells(.Rows.Count, 6).End(xlUp).Row
If Month(Date) = Month(.Cells(y, 6)) Then
.Cells(y, 7) = "HBD"
Else
.Cells(y, 7) = "No HBD"
End If
Next y
End With
End Sub
NB: Cells(Row, Column) is used in place of Range - easier for referencing a single cell using row/column numbers.

Excel function doesn't write anything

Goodmorning, i wanted to do a macro in Excel that multiply the element on the right for every element on the left (then put the result in another column), till a blank cell.
This is an example of the elements:
[enter image description here][1]
And this is what i try to write with no result...it seems like the cycle goes well, but it doesn't write anything ... could you please help me out? Anyway, sorry for my bad English, i hope i made it clear.
Thank you.
Sub test()
Range(A1).Select
x = 1
y = 1
Do Until IsEmpty(ActiveCell) And IsEmpty(ActiveCell.Offset(1, 0))
If IsEmpty(Ax) = True Then
y = x + 1
End If
If IsEmpty(Ax) = False Then
Cells(E, x).Value = Cells(A, x).Value * Cells(D, y).Value
End If
x = x + 1
ActiveCell.Offset(1, 0).Select
Loop
End Sub
you have to put the cell references as strings.
VBA will interpret Range(A1) as whatever variable A1 is set to. It is NOT the "A1" cell in your spreadsheet.
Correct is
Range("A1").Select
Similarly if you have a variable x, and want to get the cell reference A1 then you need to do something like this:
x=1
if IsEmpty("A" & x) then ...
Also, the Cells(row,column) function uses row first, then column.
I'm assuming you have "On Error Resume Next" somewhere in your code, as what you have written should throw up a lot of errors.

In a while loop how do I go to the next cell that is empty. (I'm trying not to override existing data)

Ok so the thing is, I'm writing this for an Excel Sheet, and the problem i've run into is the loop doesn't check to see if the destination cell is empty or not. So what i'm trying to do is check if the cell is empty if it is then do the existing paste. if it's not then keep looking till it finds the first empty box....can someone help with this?
Dim x, z
Set a = Sheets("Working")
Set b = Sheets("Peer Review")
Set c = Sheets("Waiting to Push")
Set d = Sheets("Completed")
x = 1
z = 2
Do Until IsEmpty(a.Range("I" & z))
If a.Range("I" & z) = "Peer" Then
x = x + 1
b.Rows(x).Value = a.Rows(z).Value
Else
If a.Range("I" & z) = "Waiting" Then
x = x + 1
c.Rows(x).Value = a.Rows(z).Value
End If
End If
z = z + 1
Loop
I'd recommend to rewrite the code as follows:
Option Explicit
Public Sub tmpSO()
Dim z As Long
Dim a As Worksheet, b As Worksheet, c As Worksheet, d As Worksheet
Set a = ThisWorkbook.Worksheets("Working")
Set b = ThisWorkbook.Worksheets("Peer Review")
Set c = ThisWorkbook.Worksheets("Waiting to Push")
Set d = ThisWorkbook.Worksheets("Completed")
z = 2
For z = a.Cells(a.Rows.Count, "I").End(xlUp).Row To 2 Step -1
If a.Cells(z, "I").Value2 <> vbNullString Then
Select Case UCase(a.Cells(z, "I").Value2)
Case "PEER"
b.Rows(b.Cells(b.Rows.Count, "I").End(xlUp).Row + 1).Value2 = a.Rows(z).Value2
a.Rows(z).Delete
Case "WAITING"
c.Rows(c.Cells(c.Rows.Count, "I").End(xlUp).Row + 1).Value2 = a.Rows(z).Value2
a.Rows(z).Delete
Case "COMPLETED"
d.Rows(d.Cells(d.Rows.Count, "I").End(xlUp).Row + 1).Value2 = a.Rows(z).Value2
a.Rows(z).Delete
Case Else
MsgBox "Unknown value " & a.Cells(z, "I").Value2 & " in row " & z & Chr(10) & "Skipping to next row..."
End Select
End If
Next z
End Sub
Changes:
Implement a for ... next instead of a loop is most of the time a better coding practice since a loop can potentially lead to an infinite loop and crash your Excel.
Using select case instead of multiple if clauses. This is not really much faster but simply better to read and understand.
I removed x because this would not always use the last row on each sheet. Instead x is incremented on each sheet and thus can lead to empty (in between) rows on all other sheets. Instead, the above code now checks column I for the last row on that sheet and then copies the row from sheet a over to the next available one.
The above code is now (no longer) case sensitive when checking for peer or Peer or pEEr in column I. I am guessing that this better suits your needs.
If an unknown value (other than peer, waiting, or completed) in column I is encountered then you get a message box telling you about it.
In accordance to your request (in the comments below) the above code now deletes any row which has been successfully copied over to another sheet. Yet, unrecognized values in column I cannot be copied over to any other sheet and (as such) stay on sheet a ("Working").
Note, that the above assumes that "empty" is defined as "there in nothing in the cell's formula. If you prefer you can also set it to "if the cell is showing no value" (instead). The difference is that if a cell contains a formula which results in "" then there is a formula in the cell but the value is currently (due to the formula) nothing.

Excel VBA formula insert in current cell

Due to beginner for VBA, I am in a difficult to find this codes.
I need to create 'Command Button' to insert formula according to
current cell location.
Eg. If current cell location is S7, need to get formula in to it '=K7*L7'.
Current cell location change all the time. Multiplication of Column K and L fixed.
Please help me to write this codes.
You can assign below code to command button
Sub Insert_Formula
n = Selection.row
Selection.Value = "=K" & n & "*L" & n
End Sub
In VBA, Selection will get the selected cell properties.
For example, if you select S7,
n = Selection.Row
Then n will be 7
Selection.Value = "=K" & n & "*L" & n
Above will set selected cell's formulat to =K7*L7
In addition, if you want the button to work on selected range which is more than one cell,
Private Insert_Formula_Multi_Cells
For X = 1 To Selection.Rows.Count
n = Selection.Row + X - 1
Selection.Range(Cells(X, 1), Cells(X, Selection.Columns.Count)) = "=K" & n & "*L" & n
Next X
End Sub
Selection.Rows.Count Gets number of rows selected.
Selection.Columns.Count gets number of columns selected
to get current location in excel you can use ActiveCell.Address command.
Below code first gets current selected cells address and then multiplies with K(11) and L(12) columns to print value in active cell.
Sub acell()
Dim s As String
s = ActiveCell.Address
Range(s).Select
Range(s).Value2 = Cells(2, 11) * Cells(2, 12)
Debug.Print s
End Sub
You can add them in loop as per your requirement.

Using a stored integer as a cell reference

Dim x As Integer
Dim y As Integer
For y = 3 To 3
For x = 600 To 1 Step -1
If Cells(x, y).Value = "CD COUNT" Then
Cells(x, y).EntireRow.Select
Selection.EntireRow.Hidden = True
End if
If Cells(x, y).Value = "CD Sector Average" Then
Cells(x, y).EntireRow.Select
Selection.Insert Shift:=xlDown
Cells(x + 1, y - 1).Select
ActiveCell.FormulaR1C1 = "=R[0]C[1]"
Cells(x + 1, y + 1).Select
Selection.ClearContents
Cells(x + 1, y + 2).Select
Selection.ClearContents
Cells(x + 1, y + 3).Select
Selection.ClearContents
Cells(x + 1, y + 4).Select
ActiveCell.FormulaR1C1 = ***"=sum(R[This is what I need to change]C:R[-3]C"***
Cells(x + 2, y).Select
End If
I need to make the starred formula come out as a sum of a column that ends 3 rows above the Sector average row and starts the number that is displayed in a cell in the Count Row.
I tried this to no avail in the count if statement
Dim count As Integer
count = Cells(x , y).Value
And then using the count variable in the cell reference and got an error.
Any tips would help or if I'm going about this wrong let me know.
You have to find a suitable formula for entering in the target cell. Then you would build such formula with string concatenation, etc., for entering it via VBA.
One option for the formula is to use OFFSET, as in
=SUM(OFFSET($A$1,D3-1,COLUMN()-1):OFFSET($A$1,ROW()-3-1,COLUMN()-1))
This sums all values from Cell1 to Cell2, in the same column you place the formula. Cell1: at the row indicated by the value in D3, Cell2: 3 rows above the cell that contains the formula.
Another option is to use INDIRECT, as in
=SUM(INDIRECT("C"&D3):INDIRECT("C"&(ROW()-3)))
This sums all values from Cell1 to Cell2, in column C. Cell1: at the row indicated by the value in D3, Cell2: 3 rows above the cell that contains the formula.
You're already using Cells(row, col) to reference your location, so you already know exactly what row you're on. Therefore:
ActiveCell.FormulaR1C1 = "=sum(R[" & x-3 & "C:R[" & X & "]C"
will give you Row("CD Sector Average")-3 through Row("CD Sector Average"). Adjust the x-3 and x as necessary, since I'm not 100% certain which rows you need to total.
Also, now that you've used the Macro Recorder to get your basic code (a great place to start, BTW, but it will teach you terrible coding habits), go read How to avoid using Select in Excel VBA macros to learn how to clean up your code.

Resources