Insert Single Cell for Filtered Rows

[Argonous]

Hello All,

I am trying to create a macro that will take an .xml file that is opened in Excel and convert the data into a single lines of useable data. I have the simple stuff like removing the formatting in place, however I am at a loss at how to insert and delete cells based on the value of certain cells.

The first thing that the macro needs to do is insert a single cell (like a tab over) after a cell that contains a specific value. The 2nd table below shows how a single cell needs to be inserted to the right of the "1L" value in the "ID" column and 2 cells inserted to the right of the "X" value in the same column. After that, I need for the macro to delete a range of cells for the value in the "ID" column and move the data from the row below upward. Finally, any row with "1E" in the "ID" column needs to be deleted. An example of how the final line of data should look is in the 3rd table below.

Hopefully someone here can help me out. Thanks in advance!


Original Data:

Key	ID	Value	Date	Time
7​	L	CJ	02/09/2021	11:53:09​
8​	1L	111	02/09/2021	11:53:09​
9​	X	818R12454	02/09/2021	11:53:09​
10​	1E	OK	02/09/2021	11:53:09​

Insert Single Cell:

Key	ID	Value	Date	Time
7​	L	CJ	02/09/2021	11:53:09​
8​	1L		111	02/09/2021	11:53:09​
9​	X			818R12454	02/09/2021	11:53:09​
10​	1E	OK	02/09/2021	11:53:09​

* Inserts cell or cells to the right of the "ID" column based on the data in each cell.

Final Result:

Key	ID	Building	Room	Asset	Date	Time
7​	L	CJ	111	818R12454	02/09/2021	11:53:09​

*Deletes a range of cells and moves the data up.

 

[ManiacB]

can you share what the raw data looks like for more than one example, i.e. eight lines of raw data.

 

[ManiacB]

See if this works for you

Sub arnge()
Dim i As Long, lr As Long

lr = Cells(Rows.Count, 1).End(xlUp).Row
For i = lr To 2 Step -1
    Cells(i - 3, 6).Value = Cells(i - 2, 4).Value
    Cells(i - 3, 7).Value = Cells(i - 2, 5).Value
    Cells(i - 3, 4).Value = Cells(i - 2, 3).Value
    Cells(i - 3, 5).Value = Cells(i - 1, 3).Value
    Rows(i & ":" & i - 2).Delete shift:=xlDown
    i = i - 3
Next i
Columns(4).NumberFormat = "0"
[A1:G1].Value = Array("Key", "ID", "Building", "Room", "Asset", "Date", "Time")
End Sub

 

[Argonous]

Here is the complete raw data file.

Book5
	A	B	C	D	E	F
1	key	dataid	value	date	time	source
2	1	S	00195B2FF607010814080310020B1800	02/09/2021	9:43:08	AUTO
3	3	3U	adf_ncccs_v6x.xml 1 mac	02/09/2021	9:43:08	AUTO
4	5	4U	6.1.0	02/09/2021	9:43:08	AUTO
5	7	L	CJ	02/09/2021	11:53:09	KEY
6	8	1L	111	02/09/2021	11:53:09	KEY
7	9	X	818R12454	02/09/2021	11:53:09	3 OF 9
8	10	1E	OK	02/09/2021	11:53:09	ACMT
9	12	L	CJ	02/09/2021	11:53:10	DEFAULT
10	13	1L	111	02/09/2021	11:53:10	DEFAULT
11	14	X	818R12455	02/09/2021	11:53:10	3 OF 9
12	15	1E	OK	02/09/2021	11:53:10	ACMT
13	17	L	CJ	02/09/2021	11:53:12	DEFAULT
14	18	1L	111	02/09/2021	11:53:12	DEFAULT
15	19	X	818R12456	02/09/2021	11:53:12	3 OF 9
16	20	1E	OK	02/09/2021	11:53:12	ACMT
17	22	L	CJ	02/09/2021	11:53:14	DEFAULT
18	23	1L	111	02/09/2021	11:53:14	DEFAULT
19	24	X	818R12457	02/09/2021	11:53:14	3 OF 9
20	25	1E	OK	02/09/2021	11:53:14	ACMT
21	27	L	CJ	02/09/2021	11:53:15	DEFAULT
22	28	1L	111	02/09/2021	11:53:15	DEFAULT
23	29	X	818R12458	02/09/2021	11:53:15	3 OF 9
24	30	1E	OK	02/09/2021	11:53:15	ACMT
25	32	L	CJ	02/09/2021	11:53:17	DEFAULT
26	33	1L	111	02/09/2021	11:53:17	DEFAULT
27	34	X	818R12459	02/09/2021	11:53:17	3 OF 9
28	35	1E	OK	02/09/2021	11:53:17	ACMT
29	37	L	CJ	02/09/2021	11:53:20	DEFAULT
30	38	1L	111	02/09/2021	11:53:20	DEFAULT
31	39	X	818R12460	02/09/2021	11:53:20	3 OF 9
32	40	1E	OK
Sheet1

 

[Argonous]

Thanks Maniac! That worked great. However, I had left off a final column (source) that I need to keep for the "X" ID. Can you modify the code to accommodate this?

Thanks again!

 

[ManiacB]

Try

Sub arnge()
Dim i As Long, lr As Long

lr = Cells(Rows.Count, 1).End(xlUp).Row
For i = lr To 2 Step -1
    Cells(i - 3, 6).Value = Cells(i - 2, 4).Value
    Cells(i - 3, 7).Value = Cells(i - 2, 5).Value
    Cells(i - 3, 8).Value = Cells(i - 1, 6).Value
    Cells(i - 3, 4).Value = Cells(i - 2, 3).Value
    Cells(i - 3, 5).Value = Cells(i - 1, 3).Value
    Rows(i & ":" & i - 2).Delete shift:=xlDown
    i = i - 3
Next i
Columns(4).NumberFormat = "0"
[A1:H1].Value = Array("Key", "ID", "Building", "Room", "Asset", "Date", "Time", "Source")
End Sub

 

[Argonous]

Works Great! Thanks so much!