I have about 30 sheets each representing a day of the week. This would save me a huge amount of time.
I have had a look in this room for problem similar to mine, but I have had no luck.
I am keen to get some help.
So the problem; I have tried to amend the below code but with no luck as I get error messages.
I am trying to copy the same data, with a slight twist.
However I want the date column, "A" which is the "same date" for each cell from A2-A85, when its pasted it goes up by 1 day every time.
The end outcome should be 7 different days consecutively when it is pasted 7 times but each time its going up.
At this moment the code allows me to copy and paste 7 times the same data.
Your help and insight would be appreciated
' this is just one sheet
Sub CopyRange()
Dim rws As Long
Sheets("20160817").Activate
With Worksheets("20160817").Range("A2:O85")
rws = .Rows.Count + 2
.Resize(rws).Copy Destination:=.Offset(rws).Resize(rws * 7)
End With
End Sub
Many thanks,
Please note, in order to get the ranges for these thirty sheets, I have had to use the concantation function and count, to work out the number of rows for each sheet. The columns is fixed A-O. In order to work out my range code.
Kind regards
Ali
Col
A B C D .......O
16/9 Data1B Data1C Data1D
16/9 Data2B Data2C Data2D
.
.
16/9 Data2B Data2C Data2D
code run
Col
A B C D .......O
17/9 Data1B Data1C Data1D
17/9 Data2B Data2C Data2D
.
.
17/9 Data2B Data2C Data2D
Continues X times the date going up by one from the previous date
try this
Sub CopyRange()
Dim rws As Long
With Worksheets("20160817").Range("A2:O85")
rws = .Rows.Count + 2
With .Resize(rws)
.Copy Destination:=.Offset(rws).Resize(rws * 7)
.Offset(rws).Resize(rws * 7, 1).SpecialCells(xlCellTypeConstants, xlNumbers) = "=R[-86]c+1"
End With
End With
End Sub
BTW, you don't need any Activate
Related
I'm working with an Excel report in which each month a new worksheet is added. Each row in the worksheet is for an employee, and the columns in that row is data related to them. Each week, the rows may vary, with names being added and removed.
I wrote the following VBA module to align the rows of 2 worksheets, adding blank rows as necessary, but I need to figure out a way to expand that so it aligns 12 worksheets, with multiple blank spaces between names as necessary. I'm not sure how to go about this, any suggestions?
Option Explicit
Sub Align()
Dim n As Long, a As Range, c As Range, x As Long
n = Cells.SpecialCells(11).Row
Set a = Worksheets("Jan").Range("A6:A200"): Set c = Worksheets("Feb").Range("A6:A200")
a(n + 1) = Chr(255): c(n + 1) = Chr(255)
a.Sort a(1), 1, Header:=xlNo
c.Sort c(1), 1, Header:=xlNo
Do
x = x + 1
If a(x) > c(x) Then
a(x).EntireRow.Insert xlShiftDown
ElseIf a(x) < c(x) Then
c(x).EntireRow.Insert xlShiftDown
End If
If x > 10 ^ 4 Then Exit Do
Loop Until a(x) = Chr(255) And c(x) = Chr(255)
a(x).ClearContents: c(x).ClearContents
End Sub
I do not believe any simple rearrangement of your existing code will meet your needs. I also believe this is too big a question to expect anyone to create an entire macro for you.
Below I outline the approach I would take to solving your problem. I suggest you try to solve each issue in turn. None of the code I give has been tested so I doubt it is error-free. Debugging my code should help you understand it. If you run into difficulties, you can come back to me with questions. However, it would be better to attempt to construct a new question including the code you cannot get working. With a single issue question, I believe you will get help more quickly than waiting for me to log in.
I hope this helps.
Issue 1 - Identifying the 12 worksheets
If the workbook only contains the 12 worksheets "Jan", "Feb" ... "Dec", then it is easy: worksheets 1 to 12. It does not matter if they are in the wrong sequence.
If the workbook contains other worksheets that are the first few worksheets of the workbook then it will be almost as easy: N to N+11.
If the other worksheets and the month worksheets are muddled, you will have to access then using an approach like this:
Dim InxMonth As Long
Dim InxWsht As Long
Dim WshtMonthName() As Variant
WshtMonthName = Array("Jan", "Feb", ... "Dec)
For InxMonth = 0 to 11
InxWsht = WshtMonthName(InxMonth)
With Worksheets(InxWsht)
:::::::
End with
Next
It might be better to use this approach anyway in case a user adds a new worksheet. This technique will work regardless of what other worksheets may exist.
Issue 2 - Get sorted list of names
You need a list in alphabetic order containing every name that appears in any worksheet. I can think of a number of approaches. I was taught: get the code working then make it faster, smoother or whatever. I have picked an approach that I think is easy to implement. Other approaches would be faster to execute but it does not sound as though you will be executing the code very often and there are only 12 worksheets. Your taking hours to debug complex code that will shave a few seconds off the run time is not a good use of your time.
Issue 3 - Sort the worksheets
You have code to sort a single worksheet. You need to put that code in a loop which you execute for each of the month worksheets.
Issue 4 - Create list of names
This approach is not very elegant and I can think of much faster approaches. However I think it is easy to understand what this code is doing.
I have initialised NameList to 200 entries because your code seem to assume that there are fewer than 200 employees. However the code enlarges the array if necessary.
Dim InxNameCrntMax as Long
Dim InxMonth As Long
Dim InxWsht As Long
Dim NameList() As String
Dim NextLowestName As String
Dim RowCrnt As Long
Dim WshtRowCrnt() As Long
ReDim NameList(6 to 200) ' 6 is first data row
InxNameCrntMax = 0
ReDim WshtRowCrnt(0 To 11)
' For each worksheet set the current row to the first data row
For InxMonth = 0 to 11
WshtRowCrnt(InxMonth) = 6
Next
Do While True
' Loop until every name in every worksheet has been added to NameList
NextLowestName = "~" ' Greater than any real name
' Examine the next row in each worksheet and find the lowest name
For InxMonth = 0 To 11
With Worksheets(WshtMonthName(InxMonth))
RowCrnt = WshtRowCrnt(InxMonth) ' Get next row for current worksheet
If .Cells(RowCrnt, "A") <> "" Then
' Not all names from current worksheet added to NameList
If NextLowestName > .Cells(RowCrnt, "A") Then
' This name comes before previous next lowest name
NextLowestName = .Cells(RowCrnt, "A")
End If
End If
End With
Next
If NextLowestName = "~" Then
' All names from all worksheets added to NameList
Exit Do
End If
' Add NextLowestName to NameList
InxNameCrntMax = InxNameCrntMax + 1
If InxNameCrntMax > UBound(NameList) Then
' NameList is full so enlarge it
ReDim Preserve NameList(6 To UBound(NameList) + 100)
End If
NameList(InxNameCrntMax) = NextLowestName
' Step the current row for every worksheet containing NextLowestName
For InxMonth = 0 To 11
With Worksheets(WshtMonthName(InxMonth))
RowCrnt = WshtRowCrnt(InxWsht) ' Get next row for current worksheet
If .Cells(RowCrnt, "A") = NextLowestName Then
WshtRowCrnt(InxWsht) = RowCrnt + 1
End If
End With
Next
Loop
Issue 5 - Using NameList
I initialised the size of NameList to (6 To 200) although it may have been enlarged so it could now be (6 To 300) or (6 To 400).
VBA is one of the few languages that does not require the lower bound of an array to be 0. It is worth taking advantage of this feature. I understand from your code that 6 is the first data row of the worksheets. That is why I set the lowest bound to 6; it means the element numbers match the row numbers.
InxNameCrntMax is the last used entry in NameList so we have something like:
NameList(6) = "Aardvark, Mary"
NameList(7) = "Antelope, John"
NameList(8) = "Bison, Jessica"
::::::
NameList(InxNameCrntMax) = "Zebra, Andrew"
So if for Worksheets("Jan") there is no Mary Aardvark, row 6 should be empty. If there is a John Antelope, his data belongs on row 7.
In your code, you use InsertRow to insert blank lines. I do not really like updating worksheets in situ because, if you mess up, you have to reload the data from a backup copy.
I would rather build worksheet "JanNew" from Jan", "FebNew" from "Feb" and so on. When all these new worksheets had been created, I would rename "Jan" to "JanOld" and so on and then I would rename "JanNew" to "Jan" and so on. Only when I was absolutely convinced I had moved the data correctly would I delete the old worksheets.
However, I have to admit your approach is easier. I leave you to decide what to do.
I have a vba script which is supposed to copy data from one sheet to another. It does by means of three nested for loops. Stepping through the code in debugging these appear to work perfectly, but when the vba script is run they appear to stop too early. Otherwise the vba script works.
I have been staring at this for hours and cannot for the life of me see what would cause the loops to stop early. I'm hoping the solution is something simple I've missed, but I am at a genuine loss, not for the first time since I started this.
The sheet is organised as follows:
Sheet1, contains the data to be copied.
Each row contains a seperate response, of which there are 55 in the test data
The sheet contains nine blocks of data, named Episode 1-9. Each episode contains column where an integer represent a start, end and interval time.
In the test data each episode is identical except for the start/end times.
The maximum value for EndTime is 36
The test data is over the first four Episode blocks only, so Episode4 contains EndTime=36 for each row
Sheet2, where the data is to go
-First column contains each RespondentID copied over 36 rows
-Second column contains numbers 1-36, thus representing that time slot for that respondent
-11 Columns after that contain the area where the data copied from sheet1 for that Respondent/Time is put. These 36x11 areas are named "Response1-55" in the test data
The logic of the vba script is as follows:
Counters:
- n counter for number of respondents
- r counter for number of episodes
- i counter for rows within the responses being copied to.
->For each response (starting with n=1 to Respondents)
--> Select the first episode (Starting with r=1 to 9)
--->For each episode
--->Read the start, end and interval times
--->Starting from i = Start to i=End copy the relevant cells from the n'th row of the r'th episode
--->Copy those cells to the i'th row of the current response on sheet2
--->When you reach the EndTime of the current episode, go to the next one (next r)
-->If the episode you just finished has 36 as its EndTime then go to the next response, or continue till you run out of episodes.->Next Response
In debugging the code appears to do exactly this.
However when I run the vba script on the test sheet it works only for episodes 1 and 2. The data from episodes 3 and 4 is not copied. Nothing is copied in its place, and the data which IS copied is correct in every respect. There are no error messages at any point.
If anyone could suggest why this might be happening I would build unto them an actual church. The answer could also be added here: https://stackoverflow.com/questions/119323/nested-for-loops-in-different-languages Which does not yet have a section for VBA.
A link to the test sheet is here: http://dl.dropbox.com/u/41041934/MrExcelExample/TornHairExampleSheet.xlsm
The relevant part of the code is here
Sub PopulateMedia()
Application.ScreenUpdating = False
'Count the total number of response rows in original sheet
Dim Responses As Long, n As Integer, i As Integer, r As Integer
Responses = (Sheets("Sheet1").UsedRange.Rows.Count - 3) ' equals 55 in test sheet
'For each response...
For n = 1 To Responses
i = 1 'Reset i for new response
Dim curr_resp As Range
Set curr_resp = Sheets(2).Range("Response" & n) 'Define a range containing all response data
For r = 1 To 9 'For each episode...
Dim curr_ep As Range 'Define a range containing episode data for all responses
Set curr_ep = Sheets(1).Range("episode" & r)
Dim Stime As Integer, Etime As Integer, Itime As Integer 'Variables contain start, end and inter-episode times
Stime = curr_ep.Cells(n, 1)
Etime = curr_ep.Cells(n, 17)
Itime = curr_ep.Cells(n, 19)
For i = Stime To (Etime + Itime) 'for each time-slot...
If i <= Etime Then
Dim a As Variant
a = curr_ep.Range(curr_ep.Cells(n - 3, 1), curr_ep.Cells(n - 3, 11))
curr_resp.Rows(i) = a 'Copy data from above current episode to current response for slots between Stime and Etime
End If
Next i
If Etime = 36 Then Exit For
Next r
Next n
Application.ScreenUpdating = True
End Sub
To disclose, I have already had help on this project from this site, VBA copy from a union of two ranges to a row of another range but the code has been changed slightly since then and this is a different problem.
Once more, thank you enormously for any help which might come of this. I have been staring at this for hours and do not see where the error is. Any guidance at all greatly appreciated.
I would post this as a comment if I could but this is too long. So here it is as a query /potential solution
I think your range references are the issue
The code below is a cut-down version of your code
curr_ep is a named range of episode1. It has a range address of $Y$4:$AQ$58
When you loop through the a variant you are setting a range with this syntax
a = curr_ep.Range(curr_ep.Cells(n - 3, 1), curr_ep.Cells(n - 3, 11))
which is equivalent to
a = curr_ep.Range("Y2:AQ2")
which means you are actually looking at AW2:BG2 not Y2:AQ2 which is what I think you may have intended, i.e. you are building in an unintended offset
Sub PopulateMedia()
n = 1
r = 1
Dim curr_ep As Range
Dim curr_test As Range
Set curr_ep = Sheets(1).Range("episode" & r)
Set curr_test = curr_ep.Range(curr_ep.Cells(n - 3, 1), curr_ep.Cells(n - 3, 11))
End Sub
I've pieced together a macro to allow me to calculate the cost of a story task by calculating the specific rate based on the developer assigned. I have the rate table on a second sheet. I am able to get a result for the cell that the macro is set to (Row 2), but want it to run on all rows. I know I have to set a generic range, but am not sure. How should I change the range declare to run on all rows?
Here is the code:
Sub GetCost()
Range("D2").Select
' Set Do loop to stop when an empty cell is reached.
Do Until IsEmpty(ActiveCell)
Dim Estimate As Integer, Assignee As String, RodRate As Integer, GarthRate As Integer, DerekRate As Integer, TotalCost As Integer
Estimate = ThisWorkbook.Worksheets("Sheet1").Range("D2").Value
Assignee = ThisWorkbook.Worksheets("Sheet1").Range("E2").Value
RodRate = ThisWorkbook.Worksheets("Sheet2").Range("B2").Value
GarthRate = ThisWorkbook.Worksheets("Sheet2").Range("B3").Value
DerekRate = ThisWorkbook.Worksheets("Sheet2").Range("B4").Value
If Assignee = "Rod" Then
TotalCost = Estimate * RodRate
ElseIf Assignee = "Garth" Then
TotalCost = Estimate * GarthRate
ElseIf Assignee = "Derek" Then
TotalCost = Estimate * DerekRate
Else
TotalCost = "0"
End If
ThisWorkbook.Worksheets("Sheet1").Range("F2").Formula = TotalCost
ActiveCell.Offset(1, 0).Select
Loop
End Sub
I have rewritten your code with explanations which I hope are enough for you to understand why. There is much more that I could say. I hope this is a good balance between too little and too much.
However, I have to point out that there are some excellent project management tools available. I do not believe this is a good use of your time.
Random points
On 32-bit computers, Long is better than Integer.
Do not declare your variables inside a loop. The scope of a variable declared inside a sub-routine is the
the sub-routine so declare them at the top of the sub-routine.
You can declare all your variables in a single Dim statement but I find it confusing unless there is a real association between two or more variable. I might have:
Dim RodRate As Long, GarthRate As Long, DerekRate As Long
because these variables are associated. However the trouble with this approach is that you will have to add MaryRate and JohnRate and AngelaRate when these people join your project.
You need an array:
Dim PersonRate(1 To 3) As Long
where PersonRate(1) = Rate for Rod, PersonRate(2) = Rate for Garth and PersonRate(3) = Rate for Derek.
But this is hardly any better. You want a table that can grow. So today:
Name Rate
Rod 20
Garth 25
Derek 15
Next week:
Name Rate
Rod 20
Garth 25
Derek 15
Mary 30
With this, you pick up the Assignee's name, run down the table until you find their name then look across for their rate.
I assume you have a table like this in Sheet2. You could keep going back to Sheet2 but better to load the table into an array.
We could have:
Dim PersonName() As String
Dim PersonRate() As Long
so PersonRate(2) gives the rate for PersonName(2).
Note in my first array declaration I wrote: PersonRate(1 To 3). This time, the brackets are empty. With PersonRate(1 To 3), I am saying I want exactly three entries in the array and this cannot be changed. With PersonRate(), I am saying I want an array but I will not know how many entries until run time.
I said we could have two arrays, PersonName() and PersonRate() and this is what I have done. This is an easy-to-understand approach but I do not think it is the best approach. I prefer structures. When you have got this macro working and before you start your next look up User Types which is the VBA name for a structure.
Consider:
With Sheets("Sheet2")
RowMax = .Cells(Rows.Count, "A").End(xlUp).Row
End With
There is a lot to explain here.
Cells means I want to address a cell within the active workbook. .Cells means I want to address a cell within the sheet identified in the With statement. This means I do not have to select Sheet1 or Sheet2 to look at their contents. Selecting worksheets is slow and the code tends to be more difficult to understand.
.Cells(Row, Column) identifies a cell. Row must be a number but column can be a number or a column code: A=1, B=2, Z=26, AA=27, etc.
Rows.Count returns the number of rows in a sheet for the version of Excel you are using. So .Cells(Rows.Count, "A") identifies the bottom of column "A".
End(xlUp) is the VBA equivalent of clicking Ctrl+UpArrow. If you are not familar with Ctrl+Arrow I suggest you play with these four controls. Note, these controls give easy to understand results with a rectangular table. However, if there are empty cells, the results can be strange.
Putting this together: .Cells(Rows.Count, "A").End(xlUp).Row means start at the bottom of column A, go up until you hit a cell with a value and return its row number. So this sets RowMax to the last row of the Rate table. When you add row 5 with Mary's name and rate, this code will automatically adjust.
Revised code
This should be enough to get you started. Welcome to the joys of programming.
' * Require all variables to be declared which means a misspelt name
' is not taken as an implicit declaration
Option Explicit
Sub GetCost()
Dim Estimate As Integer
Dim Assignee As String
Dim TotalCost As Integer
Dim PersonName() As String
Dim PersonRate() As String
Dim InxPerson As Long
Dim RowCrnt As Long
Dim RowMax As Long
' You can declare constants and use them in place of literals.
' You will see why later. I could have made these strings and
' used "A", "B", "D", "E" and "F" as the values. Change if that
' is easier for you.
Const ColS2Name As Long = 1
Const ColS2Rate As Long = 2
Const ColS1Estimate As Long = 4
Const ColS1Assignee As Long = 5
Const ColS1Total As Long = 6
' Before doing anything else we must load PersonName and PersonRate from
' Sheet2. I assume the structure of Sheet2 is:
' A B
' 1 Name Rate
' 2 Rod 20
' 3 Garth 25
' 4 Derek 15
With Sheets("Sheet2")
RowMax = .Cells(Rows.Count, ColS2Name).End(xlUp).Row
' I now know how big I want the the name and rate arrays to be
ReDim PersonName(1 To RowMax - 1)
ReDim PersonRate(1 To RowMax - 1)
' Load these arrays
For RowCrnt = 2 To RowMax
' I could have used 1 and 2 or "A" and "B" for the column
' but this is easier to understand particularly if you come
' back to this macro in six month's time.
PersonName(RowCrnt - 1) = .Cells(RowCrnt, ColS2Name).Value
PersonRate(RowCrnt - 1) = .Cells(RowCrnt, ColS2Rate).Value
Next
End With
With Sheets("Sheet1")
' I am using the same variable for rows in sheets Sheet1 and Sheet2.
' This is OK because I never look at Sheet1 and Sheet2 at the same time.
RowCrnt = 2
Do Until IsEmpty(.Cells(RowCrnt, ColS1Estimate))
Estimate = .Cells(RowCrnt, ColS1Estimate).Value
Assignee = .Cells(RowCrnt, ColS1Assignee).Value
.Cells(RowCrnt, ColS1Total).Value = 0
' Locate the Assignee in the PersonName array and
' extract the matching rate
For InxPerson = 1 To UBound(PersonName)
If PersonName(InxPerson) = Assignee Then
.Cells(RowCrnt, ColS1Total).Value = Estimate * PersonRate(InxPerson)
Exit For
End If
Next
RowCrnt = RowCrnt + 1
Loop
End With
End Sub
Tony's answer is a great solution and introduction to programming and very well written so I've +1 it. However unless I'm missing something code should always be the last resort in excel as it is very slow compared to formulas, I would have thought that a simple lookup would suffice, something like:
=D2*(vlookup(E2,'sheet2'!A:B,2,FALSE))
Copied down the column
I was wondering if it is possible for VBA excel to group all similar variables together for example, voltage_test or current_test from a large pool of variables with different test names. Besides that, is it possible also for VBA excel to add up all the values that tagged with the same input name.
I have tried using the pivot table and it seems to work as it helps to filter those with values tagged. Unfortunately, these results happened randomly, sometimes voltage_test can be = 3, sometimes it can also not be = 3. There are also many other undetermined variables such as short_circuit_tests and so on.
Say for example, (Those variables with a 1 means i need to copy)
A B C D
1 voltage_test 1
2 current_test 1
3 voltage_test 1
4 voltage_test
5 current_test
6 short_circuit_test
.
.
.
10000 voltage_test 1
What i'm trying to do is to group all similar variables together and also copying the variables along with the number of times it appears onto another worksheet.
After using VBA to group the similar variables, I will have something like the following
A B
1 voltage_test 3
2 current_test 1
I need to copy this and paste it into another spreadsheet. short_circuit_test will not be copied as it does not repeat itself.
I have thought of using the if-else statement, but it gets a bit lengthy or rather crazy when the tests adds up to 10,000.
Do share your ideas, I will greatly appreciate your help! Thanks!!!
I'm sorry for those who have came in and post your comments, I have revised my questions, I hope this cleared up some of the doubts!
You could do a simple `AutoFilter' on column B either manually or with VBA and then copy the resulting records to a second sheet
To filter "1" values in column B of the first sheet and then copy columns A&B from the filtered result to the second sheet with VBA
Sub QuickFilter()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim rng1 As Range
Application.ScreenUpdating = False
Set ws1 = Sheets(1)
Set ws2 = Sheets(2)
ws1.AutoFilterMode = False
Set rng1 = ws1.Range(ws1.[b1], ws1.Cells(Rows.Count, "b").End(xlUp))
rng1.AutoFilter 1, "1"
If rng1.SpecialCells(xlCellTypeVisible).Count > 1 Then rng1.Offset(0, -1).Resize(rng1.Rows.Count, 2).Copy ws2.[a1]
ws1.AutoFilterMode = False
Application.ScreenUpdating = True
End Sub
Your question is pretty unclear and you are making us guess what you are trying to achieve... But this is my guess:
You have data on Sheet1 that is formatted something like this:
row\col A B
1 test 1
2 test1
3 test2 1
...
...
...
10000 test10000 1
You want this to be the result on Sheet 2:
row\col A
1 test
2 test2
...
...
n test10000
where n represents the number of "tests" whose value is 1.
The following code will do this:
Dim iRow As Long
Dim i1 As Long
iRow = 1
i1 = 0
Do
If Sheet1.Cells(iRow, 2) = 1 Then
i1 = i1 + 1
Sheet2.Cells(i1, 1) = Sheet1.Cells(iRow, 1)
End If
iRow = iRow + 1
Loop While Not IsEmpty(Sheet1.Cells(iRow, 1))
User1204868,
If you are interested in a NON VBA method then you can use this Excel Formula.
=SUM(($B$2:$B$10)*($A$2:$A$10=E2)*($B$2:$B$10=1))
You have to enter this formula as an array formula (Press CTL+SHIFT+ENTER)
Edit: Snapshot attached.
Can anyone please help me. I have developed macro that keeps track of huge amount of data (note developed in excel 2007 vba) that deletes the duplicate entries with some userform options.
Let me explain my work I have 20 columns and 15000 rows ( might be increasing everymonth).
I have to delete the duplicate rows that are added every month.and The row is said to be duplicate if minimun 6 columns(out of 20) are Same.You dont need to check all 20 cloumns values in row but only 6 column values if those 6 columns value of 2 rows are same then you should eliminate that row
This is what I had done in excel 2007
Workbooks(1).Worksheets("duplicate_raw_sheet").Range(("$A$1:$R$65535"))._
RemoveDuplicates Columns:=Array(1, 2, 6, 7, 8,9), Header:=xlYes
This is the macro added in excel 2007 vba to delete the duplicate entries. I'm just checking for the columns 1,2,6,7,8,9 and deleting the row using the above 2007 macro But unfortunately It does not work on excel 2003 .
Now I need To implement it on 2003 .but this macro is not supported in excel 2003. Is there any code available to do these task? when I googled I found advanced filter = > unique records but that does not work I think so, because I need to check only 6 columns value but the advanced filter checks all columns. but I dont need that, becuase sometimes the 6 columns may be equal and the other columns might not be equal and the advanced filter may not filter it into duplicate.
Please help me guys.. What the codes I have to follow or any other way to do it. Trying it from 2 days but not getting the way to solve it. Suggest me any method that takes effect or show me the path to follow I will do it on excel vba 2003 . Thank you in advance.
Yeah, unfortunately, the feature you are using is only in 2007+.
So, you only care if the cells in columns 1, 2, 6, 7, 8, 9 are the same? I'm assuming that means you don't care if 10-20 were all the same.
With this assumption, here's an idea you can try:
Sort your entire range based on the first column.
Then, loop through each cell in the first column.
Check the value of the next cell. If the next cell is the same, then offset and check the value of the cell in the same row, but second column. If that matches, continue through all 6 columns. If they all match, delete the entire row.
So something like this (which you'll need to modify for your implementation)
Sub test()
Dim rng As Range
Dim lastRow As Integer
Dim rowsToDelete As New Collection
Dim i As Integer
lastRow = Range("A1").End(xlDown).row
For Each rng In Range("A1:A9")
For i = rng.row + 1 To lastRow
If RowIsDuplicate(rng, i) Then _
If NotExists(rowsToDelete, i) Then rowsToDelete.Add i
Next i
Next rng
'now loop through the rowsToDelete collection and delete all of the rows
End Sub
Function RowIsDuplicate(source As Range, row As Integer) As Boolean
RowIsDuplicate = False
For n = 0 To 5
'Offset(0, n) means, from the range, go down 0 rows and over n columns
If source.Offset(0, n).Value <> Range("A" & row).Offset(0, n).Value Then _
Exit Function
If n = 5 Then RowIsDuplicate = True
Next n
End Function
Function NotExists(col As Collection, i As Integer) As Boolean
Dim v As Variant
For Each v In col
If v = i Then
NotExists = False
Exit Function
End If
Next v
NotExists = True
End Function
I tested this with information in range A1:F9
1 2 3 4 5 6
1 2 3 4 5 5
1 6 5 4 9 87
1 2 3 4 5 6
1 6 5 4 9 87
1 2 3 4 5 5
1 2 3 4 5 5
1 2 3 4 5 5
1 2 3 4 5 5
I've got 6 duplicate rows in this table above. The code I posted caught them.
Its late, I'm tired... hope that helps.
Hii Justin and to the guys whom I asked the above question.Well I got an Idea when I kept on thinking about it.This is what I tried to do
Just use the Concatenate formula
Cells(2,"T").Formula = "=CONCATENATE(A2,B2,F2,G2,H2,I2)" 'append all column values into one string then insert the formula till the end
Range("T2").Copy Destination:=Range("T3:T39930") 'Apply formula to end of sheet
Now using the remove duplicates in a single column. You can delete the duplicated rows.
Sub Remove_Duplicates_in_a_column()
Dim x As Long
Dim LastRow As Long
LastRow = 39930 ' last row number say 39930
For x = LastRow To 1 Step -1
If Application.WorksheetFunction.CountIf(Range("T1:T" & x), Range("T" & x).Text)>1 Then
Range("T" & x).EntireRow.Delete
End If
Next x
MsgBox "Finished The Process"
End Sub
And its working.Well I think this is more promising way to approach because You dont need sorting or filtering techniques but one unused column. Any feed back please let me know