Hello there,
I understand the hesitation with using VBA and macros as they can be hard to understand but with this kind of request it might be a little easier to just add the code once to your worksheet and then be done with it. If you'd like I've provided a code below that has comments explaining what each line of code does and then instructions on how to use it in your workbook.
The code:
'declare variables
Dim c As Range, LR As String, mycol As Long, copytorow As Long, rng As Range
Dim AName As String
mycol = 10 'set the variable mycol equal to column 10 aka J
copytorow = 3 'set the variable copytorow to row 3
With Sheets(1) 'with the first worksheet in your workbook
AName = .Range("A3").Value 'set AName = to the value that is in cell A3
LR = .Range("A6555").End(xlUp).Row 'set LR equal to the last row in column A that contains a value
For Each c In .Range("A4:A" & LR).Cells 'loop through cells in column A from row 4 to LR (defined as the last row in column A that contains a value)
'now whenever c is used it is reference the current cell in the loop
If c.Value = AName Then 'if the current cell in the loop is equal to Aname(defined on the first loop through as the value in cell A3) then
.Range("C" & c.Row & ":I" & c.Row).Copy 'copy cells from column C to column I in the current cell in the loops row
Cells(copytorow, mycol).PasteSpecial 'paste the copied cells to the column that is currently defined
'as the variable mycol and to the row that is currently defined as copyto row
'in the first loop through that will be cell J3
'reset mycol to the last row in the copytorow +1,
'so mycol would go from being column J to column Q
mycol = .Range("IV" & copytorow).End(xlToLeft).Column + 1
'set the variable range to rows that you are copying over so later you can delete them
If rng Is Nothing Then 'if rng is not set then
Set rng = .Rows(c.Row & ":" & c.Row) 'set rng equal to the current cell in the loop's row
Else: Set rng = Union(rng, .Rows(c.Row & ":" & c.Row)) 'if it is set add another row to the range
End If
Else 'if the current cell in the loop is not equal to the variable Aname then
mycol = 10 'reset mycol to 10 (column J)
copytorow = c.Row 'reset myrow (to the current cell in the loops row)
AName = c.Value 'reset Aname to the current cell in the loop's value
End If
Next c 'move to next cell in the loop
rng.Select 'select the cells whose row were added to rng
Selection.Delete shift:=xlUp 'delete the rows
End With
How to use it:
1. Move the worksheet you would like to format so that it is the first worksheet in your workbook then Press Alt+F8 on your keyboard (this will bring up the macro window)
2. Clear the macro name field and then type the word UniqueValues
3. That will be the name for the macro you are creating
4. Select the Create option
5. In between the Sub UniqueValues( ) and End Sub copy and paste the above code I provided you.
6. The entire code once you've copied and pasted should look like this:
Sub UniqueValues() 'macro UniqueValues
'declare variables
Dim c As Range, LR As String, mycol As Long, copytorow As Long, rng As Range
Dim AName As String
mycol = 10 'set the variable mycol equal to column 10 aka J
copytorow = 3 'set the variable copytorow to row 3
With Sheets(1) 'with the first worksheet in your workbook
AName = .Range("A3").Value 'set AName = to the value that is in cell A3
LR = .Range("A6555").End(xlUp).Row 'set LR equal to the last row in column A that contains a value
For Each c In .Range("A4:A" & LR).Cells 'loop through cells in column A from row 4 to LR (defined as the last row in column A that contains a value)
'now whenever c is used it is reference the current cell in the loop
If c.Value = AName Then 'if the current cell in the loop is equal to Aname(defined on the first loop through as the value in cell A3) then
.Range("C" & c.Row & ":I" & c.Row).Copy 'copy cells from column C to column I in the current cell in the loops row
Cells(copytorow, mycol).PasteSpecial 'paste the copied cells to the column that is currently defined
'as the variable mycol and to the row that is currently defined as copyto row
'in the first loop through that will be cell J3
'reset mycol to the last row in the copytorow +1,
'so mycol would go from being column J to column Q
mycol = .Range("IV" & copytorow).End(xlToLeft).Column + 1
'set the variable range to rows that you are copying over so later you can delete them
If rng Is Nothing Then 'if rng is not set then
Set rng = .Rows(c.Row & ":" & c.Row) 'set rng equal to the current cell in the loop's row
Else: Set rng = Union(rng, .Rows(c.Row & ":" & c.Row)) 'if it is set add another row to the range
End If
Else 'if the current cell in the loop is not equal to the variable Aname then
mycol = 10 'reset mycol to 10 (column J)
copytorow = c.Row 'reset myrow (to the current cell in the loops row)
AName = c.Value 'reset Aname to the current cell in the loop's value
End If
Next c 'move to next cell in the loop
rng.Select 'select the cells whose row were added to rng
Selection.Delete shift:=xlUp 'delete the rows
End With
End Sub
6. Here, anything that appears in green is a comment meant to help you understand what the code it doing.
7. Close out of the Visual Basic Window
8. Press Alt+F8 on your keyboard
9. This time select the UniqueValues macro and then select run.
Let me know if this works for you, I understand if you still do not wish to use VBA.
Thanks!
Bookmarks