Home |
Search |
Today's Posts |
#1
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
Hi all!
I really need help with some vba programming in excel. My goal is following: I do an inventory of my schools equipment and have much info in many columns. But I just want to concentrate on column A. This is example of the room names at my school and look like this: Column A A01 A01 A02 A02 A02 A02 A02 A02 A02 A02 A04 A04 A04 A05 A05 A05 Expedition Expedition Expedition Expedition Expedition What I want now is to find the first unique value and after the value is found, insert two row under this value, but I also want to copy the unique value (in the column A, not the whole row) to the new rows, have a border (Selection.Borders(xlEdgeBottom) under the unique cell but for the whole row instead for only one column, so it look like this after the macro is finished: The requested result after the VBA script is done: Column A A01 A01 A01 <- New created row A01 <- New created row, Borders(xlEdgeBottom) for the whole row A02 A02 A02 A02 A02 A02 A02 A02 A02 <- New created row A02 <- New created row, Borders(xlEdgeBottom) for the whole row A04 A04 A04 A04 <- New created row A04 <- New created row, Borders(xlEdgeBottom) for the whole row A05 A05 A05 A05 <- New created row A05 <- New created row, Borders(xlEdgeBottom) for the whole row Expedition Expedition Expedition Expedition Expedition Expedition <- New created row Expedition <- New created row, Borders(xlEdgeBottom) for the whole row and continue on the same way for all the other room names in Column A. I have so far solved the problem to find the unique room names and insert two new rows after the unique name with a VBA script I found on some forum and after some edititing I have the following code: Sub Insert_Row_In_ColumnA() Dim Number_of_rows As Long Dim Rowinsert As Integer Application.ScreenUpdating = False Number_of_rows = Range("A65536").End(xlUp).Row Rowinsert = 2 Range("A2").Select Do Until Selection.Row = Number_of_rows + 1 If Selection.Value < Selection.Offset(-1, 0).Value Then Selection.EntireRow.Resize(Rowinsert).Insert Number_of_rows = Number_of_rows + Rowinsert Selection.Offset(Rowinsert + 1, 0).Select Else Selection.Offset(1, 0).Select End If Loop Application.ScreenUpdating = True End Sub Thanks for your help in advanced :-) |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
Find a Unique code cut and paste | Excel Discussion (Misc queries) | |||
Long list, 2 criteria, find unique, paste | Excel Discussion (Misc queries) | |||
To find Multiple values in column B for a unique value in column A | Excel Worksheet Functions | |||
based on Cell/Column content ,cut one sheet's values and paste it in other sheet? | Excel Programming | |||
Macro to find text string in a column and paste data in another | Excel Discussion (Misc queries) |