I'm a new user in VBA and I wrote the following basic code in order to eliminate duplicate data in one sheet and extract unique data into another sheet.
For example:
in Sheet1 there are total number of 184 cells which contains the same date (12/07/2007) in Column A.
I desire to take one of that date data and write it to a cell in Sheet2.
Therefore, there will be 12/07/2007 written in A1 in Sheet2.
I would appreciate any kind of help.
Code:
Sub Take_Unique()
Workbooks("historicaldata.xls").Activate
Dim i As String
Dim xrow As Long
xrow = 2
Do Until Sheet1.Cells(xrow, 1) = ""
If Sheet1.Cells(xrow, 1).Value = Sheet1.Cells(xrow + 1, 1) Then
Sheet12.Cells(xrow, 1).Value = Sheet1.Cells(xrow, 1)
End If
xrow = xrow + 1
Loop
End Sub
Another approach is my duplicate master addin.
It handles whitespace, case sensitivities and even regexp matches - so it goes beyond the default comparison.
Simpler to just copy the whole column from sheet1 to sheet12:
Sheet1.Columns(1).Copy Destination:=Sheet12.Columns(1)
Then use the RemoveDuplicates functionality to drop any duplicates (set the Header if it's present and not if it isn't)
Sheet12.Range("A:A").RemoveDuplicates Columns:=1, Header:=xlYes
Related
I have a project that I am working on where multiple conditions are checked across all rows and many columns. The issue is that columns are added/removed from the sheet, and, at present, that results in all of my cell(row,column) references being off + outputting incorrect information. I'm wondering if there's a way to make my column references more robust so that they automatically find the correct headers and use them when checking? Would a solution to this problem be able to account for multiple columns containing the exact same header text?
Basically:
No blank columns
Column headers have repeats (e.g., Column 1 header: "Financials"; Column 15 header: "Financials")
Columns are shifting right and left based on adding/removing columns from sheet
Please find a short sample of my current code below with notes:
Dim i As Integer
Dim lastRow As Long
Dim lastCol As Long
lastRow = Range("A1").End(xlDown).Row
lastCol = Cells(1, Columns.Count).End(xlToLeft).Column
For i = 2 To lastRow
Select Case Cells(i, 14).Value
Case Is = "Yes"
Select Case True
Case Cells(i, 63).Value = 6 And _
(IsEmpty(Cells(i, 77)) Or IsEmpty(Cells(i, 93)) Or IsEmpty(Cells(i, 109)) Or _
IsEmpty(Cells(i, 125)) Or IsEmpty(Cells(i, 141)) Or IsEmpty(Cells(i, 157)))
Cells(i, 174).Value = "True" '^THESE CELL VALUES ALL HAVE THE SAME COLUMN HEADER TITLE
If the table is consistent - starting at A1 and occupying a contiguous block - then Range("A1").CurrentRegion will reference the table.
You can then use .CreateNames to name the columns (that is, using Named Ranges) according to their headings.
Dim rngTable As Range
Dim rng As Range
Set rngTable = Range("A1").CurrentRegion
rngTable.CreateNames True, False, False, False
' that is, based on the first row headings
Range("Salary").Select 'prove it works
'if necessary, iterate the cells of the column,
For Each rng In Range("Salary")
rng.Value = rng.Value + 10
Next 'rng
If a column heading is duplicated ("Financial"), though, then you'll be asked to confirm and the second occurrence will overrule the first. (Or you could say "No" and the first occurrence will be named.) In which case, it is preferable that you first correct these duplicate headings.
Correcting the duplicate headings is not necessarily straight forward, but something that you should resolve anyway. If it is a specific word "Financials" (or words) that could be duplicated then this makes the task easier. You could count how many occurrences there are, and correct the second, etc., to "Financials2".
One easy way to to assign a Name to the column. Say column N has the header "Payments". First assign the Name "Payments" to that column:
Then in VBA we can code like:
Sub dural()
Dim rng As Range, colly As Long
Set rng = Range("Payments")
colly = rng.Column
For i = 2 To 100
If Cells(i, colly) = "whatever" Then
MsgBox "Help"
End If
Next i
End Sub
The code will continue to work even if you add/remove columns beforre column N.
I would like to concatenate my data from Column E and G to Column M, starting from row 2 down to a varying (every month) number of rows
somewhat like m2=e2&g2 until there's no data to concatenate.
I'm looking for possible answers but, I still can't play with all the codes I have found here because I'm just starting to learn VBA coding. Thanks in advance for the help. :)
You don't really need to use VBA if all you want to do is to concatenate two cells together - you could use the CONCATENATE worksheet function inside your worksheet. Most of the worksheets functions can be used in VBA by appending 'Application.' to them but CONCATENATE isn't one of them. In order to do what you want in VBA you can do something like this:
Option Explicit
Sub concatColumns()
With Worksheets(1)
Dim lastRow As Integer, i As Integer
lastRow = .Cells(.Rows.Count, "E").End(xlUp).row
For i = 2 To lastRow:
.Cells(i, "M") = .Cells(i, "E") & .Cells(i, "G")
.Cells.NumberFormat = "#"
Next
End With
End Sub
The above assumes that you're using the 1st worksheet and also explicitly changes the format of each "M" column entry to text so that excel doesn't auto format the result.
I have two sheets of data. The first sheet is imported data that will show total users to my site from the day before. The second sheet is a table with all historical data from those daily reports. I'd like to automate a way to copy the data from my first sheet (that data will always be in the same cell) to a new row at the bottom of my existing table. Here's what I have:
Sub Insert_New_Rows()
Dim Lr As Integer
Lr = Range("AF" & Rows.Count).End(xlUp).Row
Rows(Lr + 1).Insert Shift:=xlDown
Cells(Lr + 1, "AF") = Cells(Lr, "AF") + 1
Sheets("Day Before").Range("$A$12:$B$12").Copy
Sheets("Historical").Cells(Lr + 1, "AF").Paste
Application.CutCopyMode = False
End Sub
In this, you'll see that my table is in columns AF and AG. When I run this macro, it only adds a row, it does not copy and paste the information.
I am not really sure where your table starts on the sheet "Day Before". So, I am assuming that it starts in row 1. Based on this assumption here is a little revision to your code:
Option Explicit
Sub Insert_New_Rows()
Dim lngNextEmptyRow As Long
Dim lngLastImportRow As Long
Dim shtYstrdy As Worksheet
Set shtYstrdy = ThisWorkbook.Worksheets("Day Before")
With ThisWorkbook.Worksheets("Historical")
lngNextEmptyRow = .Cells(.Rows.Count, "AF").End(xlUp).Row + 1
.Rows(lngNextEmptyRow).Insert Shift:=xlDown
.Cells(lngNextEmptyRow, "AF").Value2 = _
.Cells(lngNextEmptyRow - 1, "AF").Value2 + 1
lngLastImportRow = shtYstrdy.Cells(shtYstrdy.Rows.Count, "A").End(xlUp).Row
shtYstrdy.Range("A1:B" & lngLastImportRow).Copy _
Destination:=.Cells(lngNextEmptyRow, "AF")
End With
End Sub
Changes:
Explicit coding as suggested by #findwindow stating the workbook and the sheet before each Range, Cells, reference.
Copy and paste in one line of code (before three lines of code).
Using lngNextEmptyRow instead of LastRow so be can skip all these +1.
Determine the size (last row) of the table on the sheet "Day Before", so we know how much we need to copy over.
I hope this is the answer you've been looking for. Let me know if I misunderstood something or if anything requires more explanations.
There is no need to Active or Select Ranges. It is best to work with the Ranges directly. Rarely should you use ActiveCell, ActiveWorkSheet, or Selection.
This is how Copy and Paste work
Here is the shorthand for Copy and Paste
Range(SourceRange).Copy Range(DestinationRange)
Know that this will work for you:
Sheets("Day Before").Range("$A$12:$B$12").Copy Sheets("Historical").Cells(Rows.Count, "AF").End(xlUp).Offset(1)
I have two columns with random times and the times come from two different sources so the columns do not have the same amount of data points. I want to start with the first time in the first column and compare it to each time in the second column. If there is a match in times, I would like to pull relevant data. After a match is found (if there is one) I would like for the code to go to the second cell in the first column and compare it to every value in the second column and so on.
Here is the code I have so far:
Sub TransferInfo()
'Activate the Sub to Convert and Format Dates
Call ConvertDates
'Define Variables
Dim st As Worksheet
Dim ts As Worksheet
Dim lastrow As Long
Dim i As Integer
j = 2
'Find and set the last used row
Set st = ThisWorkbook.Worksheets("Data Table")
lastrow = st.Cells(st.Rows.Count, "B").End(xlUp).Row
Set ts = ThisWorkbook.Worksheets("ShopFloor")
'Cycle through/compare Row J, Column 18 based on each cell in Row I, Column 14
For i = 2 To lastrow
Do Until IsEmpty(ts.Cells(j, 8)) Or IsEmpty(st.Cells(j, 2))
If st.Cells(i, 14).Value = ts.Cells(j, 18).Value Then
st.Cells(i, 15).Value = ts.Cells(j, 2).Value
Exit Do
Else
st.Cells(i, 15).Value = ""
End If
j = j + 1
Loop
j = 2
Next i
End Sub
The other sub that I call at the beginning of this sub simply rounds the times in each column to the nearest 15 minute interval to increase the likelihood of matches between the columns.
My question is: The code does not copy and paste any more information although there are times that match between the two columns. Why would the code that I have not work? Also, with larger data sets I am afraid that this the code may crash Excel and because I have a loop within a loop trying to process a lot of data a lot of times, but I don't know of a more efficient way to accomplish what I am trying to without this code.
If anyone has any insights as to why this code doesn't work I would greatly appreciate any help.
Thanks!
Based on your code, it looks like you just need an INDEX/MATCH formula. Use this in O2 and copy down:
=IFERROR(INDEX(B:B,MATCH(N2,R:R,0)),"")
No need for VBA
I need to copy a row of data onto another sheet based on a value in that row. The value is 0 and will always be found in Column J of the origin sheet. I want columns A - N copied to the second sheet. I found this script which copies the entire row. The problem is I need to preserve any data that was previously entered onto the second (destination) sheet in columns O - AZ. Unfortunately, the script below pastes the entire row to the second (destination) sheet and any data that was entered in columns O - AZ is lost.
Sub MyMacro()
Dim i As Long, iMatches As Long
Dim aTokens() As String: aTokens = Split("0", ",")
For Each Cell In Sheets("AMI").Range("J:J")
If Len(Cell.Value) <> 0 Then
For i = 0 To UBound(aTokens)
If InStr(1, Cell.Value, aTokens(i), vbTextCompare) Then
iMatches = (iMatches + 1)
Sheets("AMI").Rows(Cell.Row).Copy Sheets("AMI Fallout").Rows(iMatches + 1)
End If
Next
End If
Next
End Sub
You are copying a complete row with code like:
Sub dural()
Sheets("Sheet1").Rows(11).Copy Sheets("Sheet2").Rows(17)
End Sub
To copy only part of the row, use something like:
Sub dural2()
Set r1 = Intersect(Sheets("Sheet1").Rows(11), Sheets("Sheet1").Columns("A:N"))
Set r2 = Intersect(Sheets("Sheet2").Rows(13), Sheets("Sheet2").Columns("A:N"))
r1.Copy r2
End Sub
To answer your specific question, this code will only copy columns A:n of the specified row to the AMI Fallout worksheet.
Sheets("AMI").Cells(Cell.Row, 1).Resize(1, 14).Copy Sheets("AMI Fallout").Cells(iMatches + 1, 1)
I'm concerned about how you are determining a positive criteria for the row transfer. It looks like you are trying to Split a 0 on a comma (which doesn't exist) then loop through a single value array and check for partial matches on a 0. The partial matches produced by InStr are the most disconcerting.
Use something like this
Sheet1.Rows(cell.row) = sheet2.Rows(Cell.row).Value