I have some datas where there are multiple duplicates in column E and its dept no. in column S. What I want to do is, for any duplicate value in col E if the values of Col S are same, then it should retain the same value in the 1st duplicate and delete other duplicates. If the Col S values are not same, it should have the value as "18" in it. Eg
Col E Col S Ans
1515A 10 Retain no changes
1515AA 12 Retain as 1515AA in Col A and 12 as Col S
1515AA 12 Delete
1515AA 12 Delete
5151B 8 Retain no changes
515BB 5 Take 515BB with 18
515BB 3 Delete
I have nearly 800-1500 line items. Can anyone help me with a macro. It will be very useful for me, instead of manually finding and deleting datas.
You can use something like:
Sub EraseR()
i = 1
While Range("E" & i).Value <> ""
If (Range("E" & i + 1).Value = Range("E" & i).Value) And (Range("S" & i + 1).Value = Range("S" & i).Value) Then
Range(i + 1 & ":" & i + 1).Delete
ElseIf (Range("E" & i + 1).Value = Range("E" & i).Value) And (Range("S" & i + 1).Value <> Range("S" & i).Value) Then
Range(i + 1 & ":" & i + 1).Delete
Range("S" & i).Value = 18
Else
i = i + 1
End If
Wend
End Sub
Related
I found a Code which creates a subtotal within a table. The Formula works fine, but I do not understand the Syntax of the sum Formula for the subtotal, which is:
"=SUM(R" & j & "C:R" & i & "C)"
What is meant with R, C:R and C? Can anybody please translate how the respective Output, for example =SUMME(E$4:E$4) corresponds to this formula?
This is the subtotal output Excel function:
The Code is as follows:
Dim iCol As Integer
Dim i As Integer 'Makro f?ngt ab diese Zeilenummer an
Dim j As Integer 'Makro geht mit diese Zeilenummer im Loop weiter
Worksheets("Italy").Activate
Application.ScreenUpdating = False
i = 4 'Makro f?ngt ab diese Zeilenummer ab
j = i
'Loops throught Col B Checking for match then when there is no match add Sum
Do While Range("A" & i) <> ""
If Range("A" & i) <> Range("A" & (i + 1)) Then
Rows(i + 1).Insert
Range("A" & (i + 1)) = "Subtotal " & Range("A" & i).Value
For iCol = 5 To 11 'Columns to Sum
Cells(i + 1, iCol).Formula = "=SUM(R" & j & "C:R" & i & "C)"
Next iCol
Range(Cells(i + 1, 1), Cells(i + 1, 10)).Font.Bold = True
Range(Cells(i + 1, 1), Cells(i + 1, 10)).Interior.Color = RGB(221, 237, 245)
i = i + 2
j = i
Else
i = i + 1
End If
Loop
Application.ScreenUpdating = True
Hope I did understood what you are trying to ask. First of all you are initializing two variables, in your case i and j that are going to help you iterate through the cells.
i and j will replace in the sum formula the first, second, third and so on row and column. So, instead of =SUM(R" & j & "C:R" & i & "C) you will have =SUM(R1 & "C:R" & 4C).
The difference in between A1 and R1C1 is the way you look at it and reference to it. Using R1C1 notation can help you to iterate easier through the cells. Going to the next cell (to the right) to A1 will be something like: R1C2.
I have 20 textBoxes on a vba userform these textBoxes are supposed to take their values from a barcode reader and i created a while loop to take the values from those textboxes and input them on the next empty row , but when i check the results i get 2 problems
J = 0
While J < 20
LastRow = ws.Range("A" & Rows.Count).End(xlUp).Row + 1
ws.Range("A" & LastRow).Value = Now()
ws.Range("B" & LastRow).Value = Me.Controls("TextBox" & J + 1).Value
ws.Range("D" & LastRow).Value = Me.Controls("TextBox" & J + 2).Value
ws.Range("I" & LastRow).Value = TextBox21.Value
J = J + 1
Wend
The Quantity inserted on column D is Repeated on the Next Row Column B
Even If the TextBoxes are Empty It is still placing data As you can see on the highlighted in Red
Will post as an answer so it can be marked as such, though I listed this in a comment:
J = 0
While J < 20
LastRow = ws.Range("A" & Rows.Count).End(xlUp).Row + 1
ws.Range("A" & LastRow).Value = Now()
ws.Range("B" & LastRow).Value = Me.Controls("TextBox" & J*2 + 1).Value
ws.Range("D" & LastRow).Value = Me.Controls("TextBox" & J*2 + 2).Value
ws.Range("I" & LastRow).Value = TextBox21.Value
J = J + 1
Wend
May want to check your J max after this...
row 1 uses J = 0, so textbox 1, textbox 2
row 2 uses j = 1, so textbox 1*2+1 (3) and textbox 1*2+2 (4)
row 3 uses j =2, so textbox 2*2+1 (5) and textbox 2*2+2 (6)
etc.
I am trying to use VBA to concatenate everything between two specified rows. What's the best way to go about this?
Basically I want to leave the lines where the third cell is "U" intact, and make the sixth cell of that row the concatenation of the rows below, until we run into another row that contains a "U" in the third cell. Then the process would repeat. The number of rows between the cells containing "U" is varied.
Pic is below
Ok, this should work (haven't tested it though):
Sub My_Amazing_Skills()
Dim l As Long, i As Long
l = 1
i = 1
Do Until i > Range("A1048576").End(xlUp).Row
If Range("C" & l).Value = "U" Then
i = i + 1
Do Until Range("C" & i).Value = "U"
Range("F" & l).Value = Range("F" & l).Value & " " & Range("C" & i).Value
i = i + 1
Loop
Range("F" & l).Value = Trim(Range("F" & l).Value)
End If
l = i
Loop
MsgBox "Bow down to the great Jeremy!", vbInformation, "Your concatenating is done"
End Sub
I presume you know know where to copy this to?
Somehow after few days of googleing I didn't find any satisfying answer.
I have to find duplicates in the same column and copy them both (or more) to the new sheet to show where are the issues.
The only way I managed to do that was
For i = 2 To lastCell
If dataArray(i, 3) <> "" Then
For j = i + 1 To lastCell
If dataArray(i, 3) = dataArray(j, 3) Then
results.Range("A" & k & ":" & lastCol & k).Value = checkbook.Range("A" & i & ":" & lastCol & i).Value '
results.Range(commentAddress & k).Value = "Duplicate ID"
k = k + 1
results.Range("A" & k & ":" & lastCol & k).Value = checkbook.Range("A" & j & ":" & lastCol & j).Value
results.Range(commentAddress & k).Value = "Duplicate ID"
k = k + 1
End If
Next j
End If
Next I
But this is taking too long! I found that dictionary could be very helpful but don't really know how to use this - and it only shows the SECOND value (I need both)
So are there any other solutions to find duplicates? I need the fastest one as the file I am working on has 100K+ rows (loop in a loop is killing me)
You could try something similar to this to recreate the column with blanks replacing the duplicate values. Then you can just filter on blank values in the column to find which values or IDs are duplicates. Or write a formula that loops through column and collects addresses of cells that are empty.
=IF(A1="";"";IF(COUNTIF(A1:A100;A1)=1;A1;""))
Replace A1:A100 with the range your data occupy, or the whole column if you prefere.
I have about 70,000 rows of data and two columns (Field,Data) which repeats every 50-100 rows (Record). I would like to write something that searches for the values based on "Field Text" (I'm only interested in about 5 fields) and paste the value into a new worksheet with rows as records and columns as fields. The first field I'm searching for will need to indicate new row/record.
My first attempt at this failed, and I've found little help on the forums. Although it looks like maybe a pivot table could do this?
Visual of what I'd like to do:
Example
EDIT:
I got the result I wanted but my do until "END" isnt catching. I do have "END" in the last cell of the data. Also, I'm sure there is a more efficient way to do this, any advice? Thanks!
Sub TracePull()
Dim i As Long
Dim j As Long
i = 1
j = 1
ActiveWorkbook.Sheets("Trace").Range("A1").Select
Do Until Range("A" & i) = "END"
Do Until ActiveCell = "OTDRFilename"
i = i + 1
ActiveWorkbook.Sheets("Trace").Range("A" & i).Activate
Loop
If ActiveCell = "OTDRFilename" Then
ActiveWorkbook.Sheets("Trace").Range("B" & i).Copy
ActiveWorkbook.Sheets("Sheet1").Range("A" & j + 1).PasteSpecial Paste:=xlValue
ActiveWorkbook.Sheets("Trace").Range("A" & i).Select
i = i + 1
j = j + 1
'Else
' i = i + 1
End If
Range("A" & i).Select
Do Until ActiveCell = "OTDRSpan length"
i = i + 1
ActiveWorkbook.Sheets("Trace").Range("A" & i).Activate
Loop
If ActiveCell = "OTDRSpan length" Then
ActiveWorkbook.Sheets("Trace").Range("B" & i).Copy
ActiveWorkbook.Sheets("Sheet1").Range("B" & j).PasteSpecial Paste:=xlValue
ActiveWorkbook.Sheets("Trace").Range("A" & i).Select
i = i + 1
End If
Range("A" & i).Select
Do Until ActiveCell = "OTDRSpan loss"
i = i + 1
ActiveWorkbook.Sheets("Trace").Range("A" & i).Activate
Loop
If ActiveCell = "OTDRSpan loss" Then
ActiveWorkbook.Sheets("Trace").Range("B" & i).Copy
ActiveWorkbook.Sheets("Sheet1").Range("C" & j).PasteSpecial Paste:=xlValue
ActiveWorkbook.Sheets("Trace").Range("A" & i).Select
i = i + 1
End If
Range("A" & i).Select
Do Until ActiveCell = "OTDRAverage loss"
i = i + 1
ActiveWorkbook.Sheets("Trace").Range("A" & i).Activate
Loop
If ActiveCell = "OTDRAverage loss" Then
ActiveWorkbook.Sheets("Trace").Range("B" & i).Copy
ActiveWorkbook.Sheets("Sheet1").Range("D" & j).PasteSpecial Paste:=xlValue
ActiveWorkbook.Sheets("Trace").Range("A" & i).Select
i = i + 1
End If
Range("A" & i).Select
Do Until ActiveCell = "OTDRSpan ORL"
i = i + 1
ActiveWorkbook.Sheets("Trace").Range("A" & i).Activate
Loop
If ActiveCell = "OTDRSpan ORL" Then
ActiveWorkbook.Sheets("Trace").Range("B" & i).Copy
ActiveWorkbook.Sheets("Sheet1").Range("E" & j).PasteSpecial Paste:=xlValue
ActiveWorkbook.Sheets("Trace").Range("A" & i).Select
i = i + 1
End If
Range("A" & i).Select
Do Until ActiveCell = "OTDRWavelength"
i = i + 1
ActiveWorkbook.Sheets("Trace").Range("A" & i).Activate
Loop
If ActiveCell = "OTDRWavelength" Then
ActiveWorkbook.Sheets("Trace").Range("B" & i).Copy
ActiveWorkbook.Sheets("Sheet1").Range("F" & j).PasteSpecial Paste:=xlValue
ActiveWorkbook.Sheets("Trace").Range("A" & i).Select
i = i + 1
End If
i = i + 1
ActiveWorkbook.Sheets("Trace").Range("A" & i).Select
Range("A" & i).Select
Loop
End Sub
I think your main problem is incrementing i twice (which passes 'END' cell) at the bottom of your code.
One way to make it more readable is by using select case. Also, you can speed up the code by assigning the value directly (without copy paste) and by turning off screen updating since you have 70,000 rows. Those things will improve performance considerably.
Sub TracePull()
ScreenUpdating = False
Dim i As Long
Dim j As Long
i = 1
j = 1
ActiveWorkbook.Sheets("Trace").Range("A1").Select
Do Until Range("A" & i) = "END"
Select Case ActiveCell.Text
Case "OTDRFilename"
ActiveWorkbook.Sheets("Sheet1").Range("A" & j + 1).Value = ActiveWorkbook.Sheets("Trace").Range("B" & i).Value
Case "OTDRSpan length"
ActiveWorkbook.Sheets("Sheet1").Range("B" & j).Value = ActiveWorkbook.Sheets("Trace").Range("B" & i).Value
Case "OTDRSpan loss"
ActiveWorkbook.Sheets("Sheet1").Range("C" & j).Value = ActiveWorkbook.Sheets("Trace").Range("B" & i).Value
Case "OTDRAverage loss"
ActiveWorkbook.Sheets("Sheet1").Range("D" & j).Value = ActiveWorkbook.Sheets("Trace").Range("B" & i).Value
Case "OTDRSpan ORL"
ActiveWorkbook.Sheets("Sheet1").Range("E" & j).Value = ActiveWorkbook.Sheets("Trace").Range("B" & i).Value
Case "OTDRWavelength"
ActiveWorkbook.Sheets("Sheet1").Range("F" & j).Value = ActiveWorkbook.Sheets("Trace").Range("B" & i).Value
End Select
i = i + 1
j = j + 1
ActiveWorkbook.Sheets("Trace").Range("A" & i).Select
Loop
ScreenUpdating = True
End Sub
You might also want to consider defining the workbook and worksheet rather than relying upon activesheet. In addition, the code with break if someone forget to have 'END' entered in the last cell, so maybe just get last cell used instead of looking for 'END'
Dim wb As Workbook
Dim wskA As Worksheet
Dim wskB As Worksheet
wb = ActiveWorkbook
wskA = wb.Sheets("Trace")
wskB = wb.Sheets("Sheet1")
numofrows = wskA.Offset(wskA.Rows.Count - 1, 0).End(xlUp).Row
wskA.Range("A1").Select
Do Until i > numofrows
Select Case ActiveCell.Text
Case "OTDRFilename"
wskB.Range("A" & j + 1).Value = wskA.Range("B" & i).Value