I have an Excel file. In column B row 11 is my product number range up to 100 rows. The code should find duplicate values in the column B. My code is like this:
Dim tgtWB As Workbook
Dim tgtWS As Worksheet
Dim LstRow As Long
LstRow = range("B" & Rows.count).End(xlUp).Row
r = 11
For i = 11 To LstRow
Do until tgWS.Range("B" & i) = "0"
If tgtWS.Range("B" & i) = tgtWS.Range("B" & i+1) Then
msgbox " Duplicate/s found! " & vbCrLf & tgtWS.Range("B" &i).value
exit sub
else
r = r+1
end if
Loop
Next
I just inserted the Do until because the program would stop reading
duplicate values if values in column B are blank or zero(0). And
the code compares only the column B Row 11 and 12.
What am I doing wrong?
Please examine this to see if it can be adapted to your needs:
Sub John()
Dim tgtWS As Worksheet
Dim LstRow As Long
Set tgtWS = ActiveSheet
LstRow = Range("B" & Rows.Count).End(xlUp).Row
For i = 11 To LstRow
If tgtWS.Range("B" & i) = "0" Then Exit Sub
If tgtWS.Range("B" & i) = tgtWS.Range("B" & i + 1) Then
MsgBox " Duplicate/s found! " & vbCrLf & tgtWS.Range("B" & i).Value
Exit Sub
End If
Next i
End Sub
It will find the first set of duplicates (if they are consecutive records) You would need a double loop if the dups are not consecutive
Related
Below is a code that I am now using to automatically insert numbers to a cell that has todays date on Column A and the correct name on the first row of that column.
However, I can't seem to make it work if the names are in any other row than 1.
What changes do I need to make if I want it to search matches on row 2 or multiple rows?
Sub SyöttöEriVälilehti()
Application.ScreenUpdating = False
On Error GoTo M
Dim i As Long
Dim Lastrow As Long
Dim col As Long
col = 0
Dim LastColumn As Long
Dim DateLastrow As Long
Dim ans As String
Dim LString As String
Dim LArray() As String
Dim anss As String
Dim ansss As String
With Sheets("Malli2Data") ' Sheet name
DateLastrow = .Cells(Rows.Count, "A").End(xlUp).Row
Set SearchRange = .Range("A1:A" & DateLastrow).Find(Date)
If SearchRange Is Nothing Then MsgBox Date & " No matches", , "Oops!": Exit Sub
Lastrow = SearchRange.Row
LastColumn = .Cells(1, Columns.Count).End(xlToLeft).Column
ans = InputBox("Input name and number like so: Tom,5")
LString = ans
LArray = Split(LString, ",")
anss = LArray(0)
ansss = LArray(1)
For i = 2 To LastColumn
If .Cells(1, i).Value = anss Then col = Cells(1, i).Column
Next
If col = 0 Then MsgBox anss & " No matches": Exit Sub
.Cells(Lastrow, col).Value = ansss
End With
Application.ScreenUpdating = True
Exit Sub
M:
MsgBox "Error" & vbNewLine _
& "Check input" & _
vbNewLine & "You typedt: " & ans & vbNewLine & "Correct input type: " & vbNewLine & "Name" & ",Number" & _
vbNewLine & vbNewLine & "Try again"
End Sub
The snippet:
For i = 2 To LastColumn
If .Cells(1, i).Value = CDec(anss) Then col = Cells(1, i).Column
Next
Is searching row 1 for your name
If you want to change it and make it a variable, something like
For i = 2 To LastColumn
If .Cells(xRow, i).Value = CDec(anss) Then col = Cells(1, i).Column
Next
With xRow being your defined row to search will work.
At the same time, you could sub out the last bit within the loop and use
For i = 2 To LastColumn
If .Cells(xRow, i).Value = CDec(anss) Then col = i
Next
As they are the same thing.
edit 20201-04-23A: Use of CDec(anss) will convert the string (as gathered from "ans") into a decimal number - which can then be compared against the .Value taken out of the cell.
I know very little about VBA code, but I can follow along the lines of logic in a given example. So I googled and found a code I edited to highlight duplicates in a worksheet. However, I have a workbook with three sheets. I would like to adapt this to compare sheet 1 and sheet 3, then highlight the duplicates in sheet 1.
Sub Highlight_Dups()
Dim startRow As Integer
startRow = 2
Dim row As Integer
row = startRow
Do While (Range("A" & row).Value <> "")
Dim innerRow As Integer
innerRow = row + 1
Dim StudentID As String
Dim DT As String
Dim Description As String
StudentID = Range("A" & row).Value
DT = Range("H" & row).Value
Description = Range("J" & row).Value
Do While (Range("A" & innerRow).Value <> "")
If (Range("A" & innerRow).Value = StudentID And Range("H" & innerRow).Value = DT And Range("J" & innerRow).Value = Description) Then
Range("X" & row).Value = Range("X" & row).Value & innerRow & ", "
Range("X" & innerRow).Value = Range("X" & innerRow).Value & row & ", "
Rows(row).Interior.ColorIndex = 6
Rows(innerRow).Interior.ColorIndex = 6
End If
innerRow = innerRow + 1
Loop
row = row + 1
Loop
MsgBox "done", vbOKOnly, "done"
End Sub
Any help on how to add ???= Sheets("Sheet1") and ??? = Sheets("Sheet3")
would help me a great deal. Thanks
You might want to consider discarding the laborious task of looping through every cell while comparing it to every other and use a pair of conditional formatting rules.
Option Explicit
Private Sub cfrS1S3dupes()
With ThisWorkbook.Worksheets("sheet1")
With .Range(.Cells(2, "A"), .Cells(.Cells(.Rows.Count, "A").End(xlUp).Row, "J"))
'get rid of pre-existing cfrs
.FormatConditions.Delete
'if duplicate in sheet1 found below row, then fill red
With .FormatConditions.Add(Type:=xlExpression, Formula1:="=countifs($a$2:$a2, $a2, $h$2:$h2, $h2, $j$2:$j2, $j2)>1")
.Interior.Color = 255 'this is the color red
End With
'if duplicate anywhere in sheet3, then fill green
With .FormatConditions.Add(Type:=xlExpression, Formula1:="=countifs(sheet3!$a:$a, $a2, sheet3!$h:$h, $h2, sheet3!$j:$j, $j2)")
.Interior.Color = 5287936 'this is the color green
End With
End With
End With
End Sub
First of all, you should declare 2 sheet objects to make it easier to read and future code maintences easier:
Dim ws1 As Worksheet
Dim ws2 As Worksheet
'use this approach if your sheet's name is dinamic but never changes it's order
'Set ws1 = ThisWorkbook.Sheets(1)
'Set ws2 = ThisWorkbook.Sheets(2)
'use this if name is static
Set ws1 = ThisWorkbook.Sheets("name of worksheet1")
Set ws2 = ThisWorkbook.Sheets("name of worksheet2")
Then just put the Sheets objects in their specific locations like this (pay attention to the 'ws1's and 'ws2's):
Dim StudentID As String
Dim DT As String
Dim Description As String
Do While (ws1.Range("A" & Row).Value <> "")
innerRow = Row + 1
StudentID = ws1.Range("A" & Row).Value
DT = ws1.Range("H" & Row).Value
Description = ws1.Range("J" & Row).Value
Do While (ws2.Range("A" & innerRow).Value <> "")
If (ws2.Range("A" & innerRow).Value = StudentID And ws2.Range("H" & innerRow).Value = DT And ws2.Range("J" & innerRow).Value = Description) Then
'not sure what you are trying to do with this 3 lines, change it for your own needs
ws1.Range("X" & Row).Value = ws2.Range("X" & Row).Value & innerRow & ", "
ws1.Range("X" & innerRow).Value = ws2.Range("X" & innerRow).Value & Row & ", "
ws1.Rows(Row).Interior.ColorIndex = 6
ws1.Rows(innerRow).Interior.ColorIndex = 6
End If
innerRow = innerRow + 1
Loop
Row = Row + 1
Loop
End Sub
ps: i couldn't test it since you didn't provide the base of yours. But since you said you can read code and understand it's logic, I think you'll be fine :)
I have 8 sheets with Multiple columns data , i want these 7 sheets vlookup with sheet8 and what ever the ids are there in sheet8 should be present in all 7 sheets remaining row should be deleted.
the code is below what i have but its not working proerly still i can see some id with #N/A present in the data.
Sub delete()
Dim arr(), msg As String
Dim c As Range
Dim ws_lrow, ws8_lrow, i As Integer
Dim ws As Worksheet
ws8_lrow = Sheets("Sheet8").Cells(Rows.Count, 1).End(xlUp).Row
ReDim arr(ws8_lrow)
For i = 2 To ws8_lrow
arr(i - 2) = Sheets("Sheet8").Cells(i, 1).Value
Next i
For Each ws In ActiveWorkbook.Sheets
ws_lrow = ws.Cells(Rows.Count, 2).End(xlUp).Row
For Each c In ws.Range("B2:B" & ws_lrow)
If IsInArray(c, arr()) = 0 Then
msg = msg & "User '" & c & "' from: " & ws.Name & vbCrLf
c.EntireRow.delete xlShiftUp
End If
Next c
Next ws
MsgBox "The following users have been deleted:" & vbCrLf & msg
End Sub
Private Function IsInArray(valToBeFound As Variant, arr As Variant) As Boolean
Dim element As Variant
On Error GoTo IsInArrayError: 'array is empty
For Each element In arr
If element = valToBeFound Then
IsInArray = True
Exit Function
End If
Next element
Exit Function
IsInArrayError:
On Error GoTo 0
IsInArray = False
End Function
You are comitting a classical mistake when iterating over a range of rows, top down, and deleting rows throughout the process. In this type of situation the easiest and correct way is to loop from the bottom up. This loop should be fixed:
'For Each c In ws.Range("B2:B" & ws_lrow)
' If IsInArray(c, arr()) = 0 Then
' msg = msg & "User '" & c & "' from: " & ws.Name & vbCrLf
' c.EntireRow.delete
' End If
'Next c
Loop from the bottom up like this:
For i = ws_lrow to 2 step -1
If IsInArray(ws.Range("B" & i).value, arr) = 0 Then
msg = msg & "User '" & ws.Range("B" & i).value & "' from: " & ws.Name & vbCrLf
ws.Rows(i).delete
End If
Next i
I have an excel sheet which need do format the data
I need to format this data like this in different sheet
Note - This a small sample I created for your understanding
my test macro is below. If you want to use it, you just need to rename your sheets - "DataSheet" for the one with the data and "ResultSheet" where the result will be stored.
Sub Reformat()
Dim letter As String
Dim iRow As Integer
Dim rng As Excel.Range
Sheets("ResultSheet").Range("A1:A" & Range("A1").End(xlDown).Row).Value = Range("A1:A" & Range("A1").End(xlDown).Row).Value
Sheets("ResultSheet").Select
Range("A1:A" & Range("A1").End(xlDown).Row).RemoveDuplicates Columns:=1, Header:=xlNo
Set rng = Range("A1:A" & Range("A1").End(xlDown).Row)
For i = 1 To Sheets("DataSheet").Range("A1").End(xlDown).Row
letter = Sheets("DataSheet").Range("A" & i).Value
iRow = WorksheetFunction.Match(letter, rng)
If Range("B" & iRow).Value = "" Then
Range("B" & iRow).Value = Sheets("DataSheet").Range("B" & i).Value
Else
Range("A" & iRow).End(xlToRight).Offset(0, 1).Value = Sheets("DataSheet").Range("B" & i).Value
End If
Next i
End Sub
I have three columns of data. Is there a way using vba to insert the information into a label on a userForm?
Here is the updated code I have:
Dim rowNum As Integer
Dim lastRow As Integer
lastRow = 373
For rowNum = 2 To lastRow
report = Sheets("DATA2").Range("F" & rowNum).Text & _
" " & Sheets("DATA2").Range("G" & rowNum).Text & _
" " & Sheets("DATA2").Range("H" & rowNum).Text & vbCrLf
Next rowNum
End Sub
Try:
Dim rowNum as Integer 'loop counter
Dim lastRow as Integer
lastRow = 'some code to set the row number of the bottom row
For rowNum = 1 to lastRow
With ActiveWorksheet
myLabel.Text = myLabel.Text & .Range("A" & rowNum).Text & " " & .Range("B" & rowNum).Text & " " & .Range("C" & rowNum).Text & vbCrLf
End With
Next rowNum
EDIT
Updated to append each loop instead of over-writing
Assuming that your label can handle multiple lines, you could write a loop that iterates through each column of data and appends it to a String as a new line, and then set the text field of that label to the string you created.