How to get Count of each Column value of table?

Excel macro

• I am attempting to create a macro of some type to generate a password based on 3 parts of data, and have a set of random numbers generated at the end. I am an IT for a corporation, and we are in the process of making users' account passwords for our login system. We have around 250 employees. Making passwords individually would be pretty painstakingly long, if you can imagine. I would like the macro to take this information: In column A, Be the first and last name of the employee; In column B, Be their date of birth; In column C, Be their year in which they were employed; And turn it into the resulting password in column D. I would like it to take the first letter of their first name, then the first letter of their second name, a number from their date of birth, and a number from their year of graduation, and then add 2 random numbers generated at the end, creating a 6 digit password with 2 letters in the beginning. In example: John Doe - 08/22/1968 - 2005 which would turn into: John Doe - 08/22/1968 - 2005 - JD2577 Dim oCell As Range Dim lCt As Long Dim sOldVal As String For Each oCell In Intersect(ActiveSheet.UsedRange, ActiveSheet.Range("A:A")) If oCell.Offset(, 2) = "" Then If oCell.Text = sOldVal Then lCt = lCt + 1 Else lCt = 0 End If sOldVal = oCell.Text oCell.Offset(, 2).Value = 1000 + lCt End If Next End Sub ---------- FOLLOW-UP ---------- QUESTION: thanks a lot for your quick reply. The numbers that I am chaning are actually in column E not in column C. The part numbers are still in column A. How can I change around the macro to reflect this change so the blank values in column E are populated. -Dan ANSWER: Change each .Offset(,2) to .Offset(,4) ---------- FOLLOW-UP ---------- QUESTION: Hi Jan. I also had another question: In my column K I have a bunch of reference numbers. Some of them are listed as follows: 1RP4-5RP4 How can I write a macro to list out the full range as follows: 1RP4,2RP4,3RP4,4RP4 There are also examples like 1P5-5P5, which I need listed out as 1P5,2P5,3P5,4P5,5P5. So you can see that the format changes but I need them listed out. They are all in column K. Is this possible with a macro? I want them in the same column K and I need the listed out range to be in the same cell as the abbreviated range. Some of my ranges are written as p2-p9. These ones can stay as is. I only need the ones where the first character is the number thats increasing. Please let me know. P.S would you happen to have an email where you can be reached. Thanks again In my column K I have a bunch of reference numbers. Some of them are listed as follows: 1RP4-5RP4 How can I write a macro to list out the full range as follows: 1RP4,2RP4,3RP4,4RP4 There are also examples like 1P5-5P5, which I need listed out as 1P5,2P5,3P5,4P5,5P5. So you can see that the format changes but I need them listed out. They are all in column K. Is this possible with a macro? many of them are already written out and I want them to remain in tact. I want them in the same column K. Thanks a lot for your help In my column K I have a bunch of reference numbers. Some of them are listed as follows: 1RP4-5RP4 How can I write a macro to list out the full range as follows: 1RP4,2RP4,3RP4,4RP4 There are also examples like 1P5-5P5, which I need listed out as 1P5,2P5,3P5,4P5,5P5. So you can see that the format changes but I need them listed out. They are all in column K. Is this possible with a macro? many of them are already written out and I want them to remain in tact. I want them in the same column K. Thanks a lot for your help QUESTION: I have a table inwith a bunch of part numbers in column A, and "find numbers" in column C. However, not all the cells in column C have a value. I want to replace the blank cells in column C with a thousand and increasing by one until the part number in column A changes. So If the first 7 values in column A are part number 25, the the blank values in column c will start at a thousand and increase by one, skipping over any values already entered in that column, and then starting at one thousand again when the part number in column A changes. I want a macro to do this. ANSWER: dan, If you want to send a sample workbook to [email protected] with an explanation of what you want, I will see if I can help you. I am not going to try to guess what you want from your description. ---------- FOLLOW-UP ---------- QUESTION: I actually figured it out but I have another question: . In my column K I have a bunch of reference numbers. Some of them are listed as follows: 1RP4-5RP4 How can I write a macro to list out the full range as follows: 1RP4,2RP4,3RP4,4RP4 Ther are also examples like 1P5-5P5, which I need listed out as 1P5,2P5,3P5,4P5,5P5. So you can see that the format changes but I need them listed out. They are all in column K. Is this possible with a macro? I want them in the same column K. Thanks a lot for your help I have a table inwith a bunch of part numbers in column A, and "find numbers" in column C. However, not all the cells in column C have a value. I want to replace the blank cells in column C with a thousand and increasing by one until the part number in column A changes. So If the first 7 values in column A are part number 25, the the blank values in column c will start at a thousand and increase by one, skipping over any values already entered in that column, and then starting at one thousand again when the part number in column A changes. I want a macro to do this. I have a spreadsheet that contains rows with contiguous data in the first columns followed by columns of empty or blank cells, then followed by more columns of good data. The number of cells across each row varies but are consistent in that all rows contain good data, then empty cells, and then good data. I would like to eliminate the empty cells in the middle of each row, leaving only the first columns of good data followed by the second group of good data (no blanks in between). Is this something you can help me with? Please help me in creating a macro insuch that any columns including un labellled columns need to copied to new sheet and the column header should be added for the that copied column in the new sheet Eg When I select column D or any cell in that column in the worksheet, all the items of the selected column/s should be copied to new sheet and the column should be named as Column_4 I am looking for a macro for excel. I have thousands of cells in one column to populate. See below: (Cell B4 - thousands of more rows.) I have the following list, I need a macro to fill the cell in column B when info is placed in column C. I need the info to follow the following list: doc 1 doc 2 doc 3 doc 4 This is a macro I copied from Lotus 123 When I try to run it on excell the debug says runtime error 438 Object does not support this method. Can you tell me how to modify the do statement so it will run in excel? Thanks Jerry Sub bd() '3.)Loop using a range variable created below: Dim TestVar As Range Set TestVar = [f1] Dim CountVar As Range Set CountVar = [g1] Do CountVar.Contents = CountVar.CellValue + 1 CurrentApplication.Calc Loop Until TestVar.CellValue = 0 End Sub Stuart, I have following requirement (please see attached image): I have a sheet in which first column has repeated entries. e.g. first two entries are unique (64EM0006A). I have to merge all such cells with unique entries in the first column only. The result should show only merged cell for 64EM0006A and so one. All the column should remain as it is. Can you please guide me on how to write this macro as there is large amount of data? Thanks in advance, Regards, Pawan I need help with a macro please. I need to be able to delete all rows up to where the phrase "account history" appears. Account history will always appear in column B but the row will vary, i need to be able to get it to B1 and keep all the data underneath. I'm new to macros so any help is appreciated. many === Answer === Sub forAE_Delete() Set currentCell = Range("b1") Do While InStr(LCase(currentCell.Value), "account history") = 0 Set nextCell = currentCell.Offset(1, 0) currentCell.EntireRow.Delete Set currentCell = nextCell Loop End Sub QUESTION: Thankyou for the last solution. Sorry for so many questions,hopefully, finally for the time being: Do you know if it possible to achieve the following in anspreadsheet: .... Just by entering 2 into cell L1, cell L1 then fills with yellow, specific text ¡°Monday¡± is then entered into cell G1, Time() is entered into I1, specific text ¡°YES¡± is entered into cell C1 and cell C1 fills with yellow - this function would then apply to Cells L2/G2/I2/C2, L3/G3/I3/C3 and so on. Rod Whitehouse. - ANSWER: Rod Whitehouse, This assumes someone manually places a 2 in a cell in column L Private Sub Worksheet_Change(ByVal Target As Range) If Target.count > 1 then exit sub if Target.column = 12 then ' column L on Error goto ErrHandler Application.EnableEvents = False Target.Interior.ColorIndex = 6 me.Cells(Target.row,"G").value = "Monday" With Cells(Target.row,"I") me.Value = Time() .Format = "hh:mm AM/PM" End with With cells(Target.row,"C") me.value = "Yes" .Interior.ColorIndex = 6 End with End if ErrHandler: Application.EnableEvents = True End Sub right click on the sheet tab and select view code. Place code like the above there. End Sub ---------- FOLLOW-UP ---------- QUESTION: Just tried your latest solution: Private Sub Worksheet_Change(ByVal Target As Range) If Target.count > 1 then exit sub if Target.column = 12 then ' column L on Error goto ErrHandler Application.EnableEvents = False Target.Interior.ColorIndex = 6 me.Cells(Target.row,"G").value = "Monday" With Cells(Target.row,"I") me.Value = Time() .Format = "hh:mm AM/PM" End with With cells(Target.row,"C") me.value = "Yes" .Interior.ColorIndex = 6 End with End if ErrHandler: Application.EnableEvents = True End Sub ........ and as soon as I enter 2 in column 'L', I get the following message: 'Compile error: Method or data member not found' and it highlights the following part of the prog: Me.Value = Time() Rod Whitehouse. ANSWER: Rod Whitehouse, Sorry - a couple of typos in the code. This is tested and worked for me. Private Sub Worksheet_Change(ByVal Target As Range) If Target.Count > 1 Then Exit Sub If Target.Column = 12 Then ' column L 'On Error GoTo ErrHandler Application.EnableEvents = False Target.Interior.ColorIndex = 6 Me.Cells(Target.Row, "G").Value = "Monday" With Me.Cells(Target.Row, "I") .Value = Time() .NumberFormat = "hh:mm AM/PM" .EntireColumn.AutoFit End With With Me.Cells(Target.Row, "C") .Value = "Yes" .Interior.ColorIndex = 6 End With End If ErrHandler: Application.EnableEvents = True End Sub ---------- FOLLOW-UP ---------- QUESTION: As usual spot on and thankyou - works great: Re: Private Sub Worksheet_Change(ByVal Target As Range) If Target.Count > 1 Then Exit Sub If Target.Column = 12 Then ' column L If Target.Text = "2" Then 'On Error GoTo ErrHandler Application.EnableEvents = False Target.Interior.ColorIndex = 28 Target.Font.ColorIndex = 28 Me.Cells(Target.Row, "G").Value = "Left Message With Broker To Contact Me" With Me.Cells(Target.Row, "I") .Value = Time() .NumberFormat = "hh:mm" .EntireColumn.AutoFit End With With Me.Cells(Target.Row, "C") .Value = "Yes" .Interior.ColorIndex = 40 End With End If End If ErrHandler: Application.EnableEvents = True End Sub ............ I know i said that would be the last one but I'll make this the final query for this month (only joking) .. this is quite strange, basically, I am using two progs to enter a target value of either: '1' or '3' in any cell in column 'L' but something really strange is happening when each prog enters the: Time() in column 'I', if i enter '3' in column 'L', the Time() will appear momenterally and then dissappear but when I enter '1' in column 'L', the Time() will stay as you would have expected it to. I notice that if I place the faulty prog above the other prog in viewcode, then the fault is corrected but as you can probably guess, the other prog is now producing the faulty result - i have seen this kind of symptom before when there are conflictions in progs but i have now idea where the confliction can be on this one? Rod Whitehouse. --- A colleague provided me with a test spreadsheet with a Macro enabled. My task it to use that Macro in another sheet that I have created. I can't find his work to copy and paste and I am not certain if that is the correct method. Can you help me read his macro and/or apply it to another file? QUESTION: The following is a portion of a large macro I am trying to write. When it compares what is in the current cell, it ALWAYS says it is false. Can you help me havecompare it correctly? For c = 1 To lastrow Step 1 ActiveCell.Select If ActiveCell.Select = "Susp" Then ActiveCell.Offset(-1, 0).Range("A1").Select Selection.Cut ActiveCell.Offset(1, 0).Range("A1").Select selction.Paste Else: ActiveCell.Value = "" End If ActiveCell.Offset(1, 0).Select Next c ANSWER: It looks like your last line is wrong, corrected below For c = 1 To lastrow Step 1 ActiveCell.Select If ActiveCell.Select = "Susp" Then ActiveCell.Offset(-1, 0).Range("A1").Select Selection.Cut ActiveCell.Offset(1, 0).Range("A1").Select selction.Paste Else: ActiveCell.Value = "" End If ActiveCell.Offset(C, 0).Select Next c ---------- FOLLOW-UP ---------- QUESTION: OK - that makes since, but it still does not recognize the Susp in the cell as Susp. It clears the cell as in the Else statement. I have a spreadsheet which I sorted to have the status (active,hold,cancelled) of a client in column B. I wrote a macro to put a number in column A based on the status date (1 is today,all others are "") so that I can import today's new active clients to another spreadsheet. In the macro I convert the formulas to value hoping that my "" cell would show as blank so that when I write: ActiveCell.End(xlDown).Select ActiveCell.Offset(1, 0).Select I could have my cursor on the first cell of the range below which I wan to delete (so that I don't enter the same name twice). Unfortunately the Command down arrow does not not work as the cell are no longer considered blank and I end up at the bottom of the spreadsheet. Any suggestions to work around this? years ago it was easy I could write "if cell=1 go down one" and it would stop at the first O cell.

• Answer:

  On a new sheet, enter in cell A2 John Doe in B2 8/22/1968 and in C2 2005 Continue with the other names below this, in A3:C3, A4:C4, etc. In D1, enter =LEFT(A1,1)&MID(A1,FIND(" ",A1)+1,1)&MOD(DAY(B1),10)&MOD(C1,10)&INT(RAND()*10)&INT(RAND()*10) Copy from D1 down col D, as far as your names go. Calculate. Then save col D, from D2 down, as values. you don't care where the blank cell is in the row. I assume if the cell above is blank, then you don't want it copied down - Sub fillcells() Dim r As Range, cell As Range Set r = ActiveSheet.UsedRange Set r = r.Resize(, r.Columns.Count - 2) If r(1).Row = 1 Then Set r = r.Offset(1, 0).Resize(r.Rows.Count - 1) End If For Each cell In r.SpecialCells(xlBlanks) If Len(Trim(cell.Offset(0, 2))) <> 0 And _ Len(Trim(cell.Offset(-1, 0))) <> 0 Then cell.Interior.ColorIndex = 3 cell.Value = cell.Offset(-1, 0) End If Next End Sub that seemed to work for me as I understand the rules. Test it on a copy of your worksheet in case I haven't captured your requirement. I'd keep it simple and before running the macro, filter the table on 1000 in that column, then simply delete all 1000's and after that, unfilter the table and run the macro. The second question: Sub WriteOut() Dim oCell As Range Dim vTemp As Variant Dim lCt As Long Dim lStart As Long Dim lEnd As Long For Each oCell In Intersect(ActiveSheet.UsedRange, Range("K:K")) If InStr(oCell.Value, "-") > 0 Then vTemp = Split(oCell.Value, "-") If IsNumeric(Left(vTemp(1), 1)) Then lStart = CLng(Left(vTemp(0), 1)) lEnd = CLng(Left(vTemp(1), 1)) oCell.Value = "" For lCt = lStart To lEnd oCell.Value = oCell.Value & lCt & Mid(vTemp(0), 2, Len(vTemp(0)) - 2) & "," Next oCell.Value = Left(oCell.Value, Len(oCell.Value) - 1) End If End If Next End Sub Of course I have an email address. See www.jkp-ads.com, bottom of each page. Dan, this worked as I designed it to work. Hopefully that is consistent with what you want. Option Explicit Sub ABC() Dim r As Range, r1 As Range, cell As Range Dim b As String, sb As String, e As String Dim se As String, j As Long, i As Long Dim v As Variant, cnt As Long Dim rw As Long, bFound As Boolean Dim r2 As Range rw = 1 Do Set r = Nothing Set r2 = Nothing On Error Resume Next Set r = Range(Cells(rw, "K"), Cells(Rows.Count, "K").End(xlUp)) If r.Count > 1 Then Set r2 = r.SpecialCells(xlConstants, xlTextValues) Else Set r2 = r End If On Error GoTo 0 If r2 Is Nothing Then Exit Do bFound = False For Each cell In r2 If InStr(1, cell.Value, "-", vbTextCompare) Then bFound = True Set r1 = cell v = Split(r1.Value, "-") b = Left(v(LBound(v)), 1) sb = Right(v(LBound(v)), Len(v(LBound(v))) - 1) e = Left(v(UBound(v)), 1) se = Right(v(UBound(v)), Len(v(UBound(v))) - 1) j = cell.Row cnt = CLng(e) - CLng(b) cell.Offset(1, 0).Resize(cnt, 1).Insert Shift:=xlShiftDown For i = CLng(b) To CLng(e) Cells(j, "K").Value = i & sb j = j + 1 rw = j Next i End If Next If Not bFound Then Exit Do Loop End Sub This function Public Function ReturnArrayVar(var As String) As String Dim startnumber As Double Dim endnumber As Double startnumber = Val(Left(var, 1)) endnumber = Val(Mid(var, InStr(var, "-") + 1, 1)) Dim mainstring As String mainstring = Left(var, InStr(var, "-") - 1) mainstring = Right(mainstring, Len(mainstring) - 1) Dim looper For looper = startnumber To endnumber ReturnArrayVar = ReturnArrayVar & looper & mainstring If looper <> endnumber Then ReturnArrayVar = ReturnArrayVar & "," Next End Function Should do it for you ¨C you can either use a helper column to get the results first, then copy and paste special, values OR you can use a macro to update each cell in the range dan This worked for me. At least it worked as I designed it to work. Option Explicit Sub ABC() Dim r As Range, r1 As Range, cell As Range Dim b As String, sb As String, e As String Dim se As String, j As Long, i As Long Dim v As Variant, cnt As Long Dim rw As Long, bFound As Boolean Dim r2 As Range rw = 1 Do Set r = Nothing Set r2 = Nothing On Error Resume Next Set r = Range(Cells(rw, "K"), Cells(Rows.Count, "K").End(xlUp)) If r.Count > 1 Then Set r2 = r.SpecialCells(xlConstants, xlTextValues) Else Set r2 = r End If On Error GoTo 0 If r2 Is Nothing Then Exit Do bFound = False For Each cell In r2 If InStr(1, cell.Value, "-", vbTextCompare) Then bFound = True Set r1 = cell v = Split(r1.Value, "-") b = Left(v(LBound(v)), 1) sb = Right(v(LBound(v)), Len(v(LBound(v))) - 1) e = Left(v(UBound(v)), 1) se = Right(v(UBound(v)), Len(v(UBound(v))) - 1) j = cell.Row cnt = CLng(e) - CLng(b) cell.Offset(1, 0).Resize(cnt, 1).Insert Shift:=xlShiftDown For i = CLng(b) To CLng(e) Cells(j, "K").Value = i & sb j = j + 1 rw = j Next i End If Next If Not bFound Then Exit Do Loop End Sub Sub fixer() Dim checkvar As String Dim Loopervar As Double Dim SetVar As Double SetVar = 1000 checkvar = Range("A1").Value For Each cell In Range("C1:c13") If cell.Offset(0, -2).Value = checkvar Then If cell.Value = "" Then cell.Value = SetVar SetVar = SetVar + 1 End If Else checkvar = cell.Offset(0, -2).Value If cell.Value = "" Then cell.Value = 1000 SetVar = 1001 Else SetVar = 1000 End If End If Next End Sub Will do it for you ¨C you will need to change my example range from c1:c13 to whatever you are actually checking! Hello Dave, If I understand your question correctly, the following macro should eliminate the blanks as you want. I'm assuming that when an empty cell is found you want everything to the right of it shifted one cell to the left (and so on, until all the data are contiguous within all rows). Here's the code: Sub ElimEmptyCols() 'Eliminates empty columns in all rows by shifting cells to left Dim iRow As Long Dim iCol As Integer With ActiveSheet.UsedRange For iRow = 1 To .Rows.Count For iCol = .Columns.Count To 1 Step -1 If IsEmpty(.Cells(iRow, iCol)) Then .Cells(iRow, iCol).Delete shift:=xlToLeft End If Next iCol Next iRow End With End Sub To install this code in your workbook go to the Visual Basic Editor (Alt-TMV), insert a new macro macro module (Alt-IM), and paste this code into the Code pane. To run this macro go back toand Alt-TMM, select ElimEmptyCols, and Run. I can do it pretty quickly once you answer following questions -- (1) What are names of sheets - Original and destination of copy? (2) Does original sheet have column headers? If yes,should they also be copied? If Yes, will new column header replace the old header or both will remain in first two rows? (3) How many rows are there in original sheet? Will they increase? (4) Is there any column in original sheet that will always be filled in (not empty)? Regards Cheryl I'm not totally sure of the question but--- I believe you can do what you want with a formula. The formula might look like this +=IF(C714>0,+E714,"") The formula says if cell C714 is greater than zero (in other words an entry is made in it) then bring over the value from cell E714. In column E beginning with row 714, I created a list that says doc 1, doc 2, doc 3, and so on. The easiest way to create the list is to type in cell E714 doc 1 then copy down the series for as many rows as are needed. The formula to bring over the values from column E can be copied down for as many rows as are necessary. Richard Jerry Hill, this worked for me; Sub bd() '3.)Loop using a range variable created below: Dim TestVar As Range Set TestVar = [f1] Dim CountVar As Range Set CountVar = [g1] TestVar.Formula = "=1/G1" Do CountVar.Value = CountVar.Value + 100 Application.Calculate Loop Until TestVar.Value End Sub First, I know nothing about the Lotus 1-2-3 object module. The only programming I did in lotus 1-2-3 was pretty much key stroke programming. So I am guessing on the function of the properties you have. a range has many properties, but the closest to what you show would be Lotus Property CellValue would just be Value Contents would probably be Text, but text is readonly so you would use value again for what you are doing. [f1] and [g1] are legal ways to reference a cell, but the more common method (and faster although for simple usage, not a significant difference) is Range("F1") Range("G1") Your code depends on a formula in F1 that will go to zero. I couldn't think of a good function that would actually equate to zero in such a scenario, so I just put in an inverse function and increased the increment loop in incrmeents of 100. Sub bd() '3.)Loop using a range variable created below: Dim TestVar As Range Set TestVar = Range("F1") Dim CountVar As Range Set CountVar = Range("G1") TestVar.Formula = "=1/G1" Do CountVar.Value = CountVar.Value + 100 Application.Calculate Loop Until TestVar.Value End Sub getting an equality test for zero would probably be difficult unless you were using integers (without knowing what is in your sheet - you may be using a If statement or something). Sub mergeCells() 'assuming a column of values begins in cell A2 and continues down 'till the first blank cell. In all cases where adjacent cells have 'the same value in this column, merge them into one cell. Dim topCell As Range, botCell As Range Set topCell = Range("a2") Application.DisplayAlerts = False Do Until topCell = "" If topCell.Offset(1) = topCell Then Set botCell = topCell.Offset(1) Do Until botCell <> topCell Set botCell = botCell.Offset(1) Loop Range(topCell, botCell.Offset(-1)).Merge Set topCell = botCell Else Set topCell = topCell.Offset(1) End If Loop Application.DisplayAlerts = True End Sub Rod Whitehouse, You should only have one of each type of event. If you had more, you should get an error - so it is hard to know what you actually have. Perhaps you are using Change and SelectionChange which are two different events. But if you want to react to differently to different entries, then you would have one change event and use if statements or a case statement to run different codes Private Sub Worksheet_Change(ByVal Target As Range) If Target.Count > 1 Then Exit Sub If Target.Column = 12 Then ' column L On Error GoTo ErrHandler Select Case Target.value Case 1 ' code to execute if a 1 is entered Case 2 Application.EnableEvents = False Target.Interior.ColorIndex = 28 Target.Font.ColorIndex = 28 Me.Cells(Target.Row, "G").Value = "Left Message With Broker To Contact Me" With Me.Cells(Target.Row, "I") .Value = Time() .NumberFormat = "hh:mm" .EntireColumn.AutoFit End With With Me.Cells(Target.Row, "C") .Value = "Yes" .Interior.ColorIndex = 40 End With End If End If Case 3 ' code to execute if a 3 is entered end Select ErrHandler: Application.EnableEvents = True End Sub as an example. If you have any other prog then you should probably delete it or write it so it doesn't interfer with the change event. If you open his workbook and do Alt+Fll, this should take you to the VBE. In the VBE, on the left side is the Project Manager. It should show entries like - VBAProject(yourworkbookname.xls) - MicrosoftObjects sheet1(sheet1) sheet2(sheet2) sheet3(sheet3) ThisWorkbook - Modules Module1 The (-) could be (+). If you see a + sign, then click on it to expand its members below If you just see Modules like + folder_icon Modules then click on the + sign to expand the Modules if you see a module listed under Modules then double click on that to make it visible. There should be code there. If modules isn't there or it is there and you don't find any code in the module(s) listed then you can double click on the thisworkbook workbook entry. If no code there, you can double click on each Sheet entry. If there is a class module listed, you can double click on that. Those are the locations where code can be stored. Of course it is possible that when you look in the project manager you just see the workbook listed + VBAProject(yourworkbookname.xls) then click on the + sign to expand it. If you are prompted for a password, then the other person has locked the project. If that is the case, I would guess they don't want to share the code with your, but want you to use their macro from their workbook. If that is the case, you just go Tools=>Macros=>Macros (in Excel 2003 and earlier) select the macro you want and run it. in Excel 2007, you would go to the View tab and on the right side is a Macros command button. Click on the down arrow, select view macros. Select the macro and run it. The macro would need to be designed to work on the ActiveWorkbook in Excel, so you would make YOUR workbook the active workbook (and not the workbook that contains the code). Otherwise, if you found the code, you can copy it from the other workbook and put it in a corresponding location in your workbook. remember that Alt+Fll toggles betweenand the Visual Basic Editor and Back to excel. So there are a lot of possibilities. Try this with the msgboxes so you can see what the activecell is For c = 1 To lastrow Step 1 ActiveCell.Select Msgbox ActiveCell.address & vbcr & "ActiveCell contains: " & ActiveCell If Trim(UCASE(ActiveCell)) = "SUSP" Then Msgbox ActiveCell.Offset(-1, 0).Range("A1").address ActiveCell.Offset(-1, 0).Range("A1").Select Selection.Cut ActiveCell.Offset(1, 0).Range("A1").Select Msgbox ActiveCell.Offset(1, 0).Range("A1").address selction.Paste Else: ActiveCell.Value = "" End If ActiveCell.Offset(C, 0).Select Next c You don't have to ever select a cell before doing anything to it or with it Nicolas, You could change the "" to " " then select the column and do edit=>Replace replace what: ' put in a space replace with: ' leave blank then the cells will be blank. Part of what you show is code, so if it is appropriate, you can use replace in code as well. Here is a sample. Run this on a blank sheet. Sub ABC() With Range("A1:A10") .Formula = "=if(row() End With Range("A1:A10").Replace What:=" ", _ Replacement:="", _ LookAt:=xlWhole, _ MatchCase:=False Range("A1").Select ActiveCell.End(xlDown).Select ActiveCell.Offset(1,0).Select End Sub the selection should end up in A6.