What i want to do is to loop through the rows of a table, And checking each row in a column for duplicates.
For example I will start with cell A2, say it has a text value of "CAP". I want to compare that value "CAP" with all of the other rows in that Column.
If it finds a Duplicate i want it to put in the Column dupe "Dupe1" so both records have the same dupe number.
Then it moves to A3 and checks that value with all of the other rows in that column. so on so on.
If more dupes are found then they are names "Dupe2", "Dupe3" etc...
I am struggling to figure out how to achieve this?
For Example, you have two columns:
Column A | Dupe
1
2
3
4
4
5
4
Sub Button1_Click()
n = ThisWorkbook.Worksheets(1).Range("A:A").Cells.SpecialCells(xlCellTypeConstants).Count
Dim Counter As Integer
Counter = 1
Duplicate = 0
For i = 2 To n
If Len(Trim(Worksheets(1).Cells(i, 2))) = 0 Then
For j = i + 1 To n
If Worksheets(1).Cells(i, 1) = Worksheets(1).Cells(j, 1) Then
Worksheets(1).Cells(i, 2) = "Dupe" + CStr(Counter)
Worksheets(1).Cells(j, 2) = "Dupe" + CStr(Counter)
Duplicate = 1
End If
Next j
End If
If Duplicate = 1 Then
Counter = Counter + 1
Duplicate = 0
End If
Next i
End Sub
Related
Hi Everyone I'm new to VBA Code & I'm Stuck with this one. I hope someone help me..
Step 1: compare the row with every SU headers. Here in row2, the value in SU_BS is 211. Once there is a value in SU , the column NAME2 should display the corresponding NAME (s1) with SU value (211). So NAME2 should display s1 211.
Step 2: Once NAME2 display the value, want to move to the next row without further checking SU headers.
Step 3: As per step 1 & 2 the column NAME2 in Next row will also display S1 211. But what i need is while filling the value, NAME2 column should check for the duplicate value. If duplicate value exist the control moves to next SU header. If the SU header has no value, move on to the next SU header if value exist NAME2 should display the value (S1 ZY) in row3.
Use an array to store each row and previous row in turn, compare elements until different.
Option Explicit
Sub macro()
Dim ws As Worksheet
Set ws = ActiveSheet
Dim r As Long, c As Integer, n As Integer
Dim k As Integer, kLast As Integer
Dim ar(4, 1) As String
r = 2 ' start row
While Len(ws.Cells(r, 1)) > 0
' fill array
For n = 0 To 3
c = n * 2 + 4
ar(n, 1) = ws.Cells(r, c)
Next
k = 0
If r > 2 Then
' compare
While k <= kLast And ar(k, 1) = ar(k, 0)
k = k + 1
Wend
' skip pass any blanks
While Len(ar(k, 1)) = 0 And k <= 3
k = k + 1
Wend
End If
' output
ws.Cells(r, 3) = ws.Cells(r, 2) & " " & ar(k, 1)
' remember last row
For n = 0 To 3
ar(n, 0) = ar(n, 1)
Next
kLast = k
r = r + 1
Wend
MsgBox "Done"
End Sub
I have an excel table that should contains only unique values in each row. If any of the previous cell values repeating anywhere in the other rows, the complate row should be deleted. The example table is like so
Example
Table The result
______ _____
0 1 3 0 1 3
6 4 1 5 -> 8 9 2
8 9 2
The second row should be cleared because the first row already contains 1 . But the third row should be there because it doesn't contains any duplicates from the previous rows.
I need excel formula to filter like so or vba code with multi dimensional array clearing the unwanted rows.
Try this one...
It works with all the samples I took.
Dim i, j, k, l As Long
LastRow = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
LastCol = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Column
For k = 1 To LastRow
For i = k + 1 To LastRow
For j = 1 To LastCol
For l = 1 To LastCol
If (Sheets(1).Cells(i, j).Value2 <> "") And _
(Sheets(1).Cells(k, j).Value2 <> "") And _
(Sheets(1).Cells(i, j).Value2 = Sheets(1).Cells(k, l).Value2) Then
Sheets(1).Cells(i, j).EntireRow.ClearContents
End If
Next
Next
Next
Next
Range("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Hi I am trying to compare two sets of data by having indicators if they increased, decreased, or stayed the same. I was able to get it working on one column. My problem is I can't loop it on multiple columns.
Basically:
If A1 = C1 then D1.Value = 0
If A1 > C1 then D1.Value = 1
If A1 < C1 then D1.Value = 2
I've tried to do the "do while" to add increments on the columns but it did not work.
Sub ChangeIndicator2()
Dim i As Long
Dim a As Long
Dim b As Long
Dim x As Long
Dim y As Long
Dim ProgramCount As Long
i = 2
a = 8
b = 2
x = 0
y = 8
ProgramCount = 12
Do While y <= ProgramCount
For Each c In Worksheets("Sheet1").Range("A2:A20").Offset(x, y)
If Worksheets("Sheet1").Cells(i, a).Value = Worksheets("Sheet1").Cells(i, b).Value Then
c.Value = 0
ElseIf Worksheets("Sheet1").Cells(i, a).Value < Worksheets("Sheet1").Cells(i, b).Value Then
c.Value = 1
ElseIf Worksheets("Sheet1").Cells(i, a).Value > Worksheets("Sheet1").Cells(i, b).Value Then
c.Value = 2
End If
i = i + 1
Next c
a = a + 2
b = b + 2
y = y + 2
Loop
End Sub
Only the first column works, the second column only shows 0 values.
So basically, what you want to do is compare 2 columns which are 2 columns apart and repeat that on another pair of columns which is 8 columns from the first column. If my assumption is correct then have a go at this:
For i = 0 To (ProgramCount * 8) Step 8
With Worksheets("Sheet1").Range("A2:A20").Offset(, i + 3)
.FormulaR1C1 = "=IF(RC[-3]=RC[-1],0,IF(RC[-3]>RC[-1],1,2))"
.Value2 = .Value2
End With
Next
Adjust the offset to suit your needs (I may have misunderstood the actual columns you target to update). Hope this helps.
I have an excel 2007 sheet where column names with data are all placed in one single column and I need to shift one column name to the left or right with data so that I can have separate columns. Can you create a VBA function where it reads all rows of the column and shift those columns with certain keywords. Such as:
A1 B1
1 **Category1**
Cat1 info here
**cf**
45
34
34
Sf
542
234
234
2 **Category2**
Cat2 info here
**cf**
76
23
67
**Sf**
678
987
3476
I Need to move "cf" column + data to a different column and paste it to its relevant category. So "cf" would shift right with data and move up along with its category. I would then delete the empty rows of B Column.
Finally had it figured out, Bad coding maybe but it works.. :)
Thanks All for your Help .
Sub test()
Dim i As Long
Dim toprow As Long
Dim z As Long
Dim count As Long
Dim b As Long
toprow = 3
b = toprow
For i = toprow To Cells(Rows.count, 1).End(xlUp).Row
If Not Cells(i, 1) = "" And Not Cells(i, 2) = "" Then
b = i
count = 0
z = i
End If
If Cells(i, 1) = "" Then
If Cells(i + 1, 1) = "" Then
z = i
If Not Cells(z + 1, 2) = "" Then
Cells(z + 1, 2).Cut Cells(b, 2)
i = b
b = z + 1
count = 0
ElseIf count = 0 Then
count = z
b = count
End If
End If
End If
Next i
End Sub
I have data in single column Sheet1!A10:A122.
I want to copy this data into multiple rows of another sheet Sheet2!A14:G14 and A15:G15 and A16:G16 and so on until the last non blank cell in Range(A10:A122).
How can I achieve this using vba?
Try using a for loop
' Declare worksheets to variables
set ws = ThisWorkbook.Sheets(Sheet1)
set ws2 = ThisWorkbook.Sheets(Sheet2)
' Column Counter (A=1)
h = 1
' Start For loop between lower and upper bound of range (10 to 122)
For i = 10 to 122
' If the position of the column on Sheet2 has gone beyond G reset to A and move to next row
if j > 7 then j = 1: h = h + 1
' Copy Data
ws.cells(i,1) = ws2.cells(h, j)
' Move along one column
j = j + 1
Next i
I got the answer for my Question myself. Here it is
{
n = 10
For k = 14 To Sheets("Sheet1").Range("A10:A"&Rows.Count).SpecialCells(xlCellTypeBlanks).Row
For m = 1 To 7
Sheets("Sheet2").Cells(k, m) = Sheets("Sheet1").Cells(n, 1)
n = n + 1
Next
Next
}