Thread: Find string and re-arrange values from table

Hi all,

I have a worksheet which contains 3 columns of values on the "Data" worksheet. Like below:


3 Fig Monday
4 Fig Monday
3 Banana Tuesday
5 Pineapple Tuesday
12 Coconut Wednesday
32 Mandarine Wednesday
6 Cucumber Thursday
3 Tomato Thursday
14 Lettuce Thursday


And I am looking to write a macro which will re arrange the table format once a button is pressed to make it look like this:


Monday
3 Fig
4 Fig
Tuesday
3 Banana
5 Pineapple
Wednesday
12 Coconut
32 Mandarine
Thursday
6 Cucumber
3 Tomato
14 Lettuce

So my macro needs to be able to find the day of the week in the 3rd column and return whatever is in the 2 cells to the left of it, and if there are any other "Monday" cases find those also and return their values, and so on for the other days of the week.

I have begun writing code but am not sure whether to use a find function or a vlookup type macro.

I have pasted what I have so far but not sure if I am on the right track...

Private Sub CommandButton1_Click()
Dim s As String
Dim i As Integer
Dim f As Integer
Dim g As Range
Activate Range("A12")


For i = 2 To 10


   
mySelectedArea = ThisWorkbook.Worksheets("Data").Range("A" & i & ":" & "C" & i)
s = Application.VLookup("Apple", mySelectedArea, 3, False)

ActiveCell = s

Next i

End Sub

Thanks in advance!!!

Cheers,

Dexter

Try this

Private Sub CommandButton1_Click()
    Dim LastRow As Long, RowNo As Long
    
    LastRow = Range("C" & Rows.Count).End(xlUp).Row
    For RowNo = LastRow To 2 Step -1
        If Cells(RowNo, "D") <> Cells(RowNo - 1, "D") Then
           Cells(RowNo, "D").EntireRow.Insert
           Cells(RowNo, "B") = Cells(RowNo + 1, "D")
        End If
    Next
    LastRow = Range("D" & Rows.Count).End(xlUp).Row
    Range("D1:D" & LastRow).Clear
End Sub

Hope this helps

Hmm?

.......I am looking to write a macro which will re arrange the table format once a button is pressed to make it look like this ......

That looks like adding rows to me!
And what graph? There was no mention of it in your original post and it isn't in your sample workbook!!!

However.
With your sample sheet, clear the contents of Column A, or put the contents elsewhere.

Then run this macro.

Private Sub CommandButton1_Click()
    Dim LastRow As Long, RowNo As Long

    LastRow = Range("C" & Rows.Count).End(xlUp).Row
    For RowNo = LastRow To 2 Step -1
        If Cells(RowNo, "D") <> Cells(RowNo - 1, "D") Then
            Cells(RowNo, "A") = Cells(RowNo, "D")
        End If
    Next
    Range("D1:D" & LastRow).Clear

End Sub

Hope this helps

One more aproach.You can select the range and run this macro to get result in the immediate right column

Sub DoIt()
 Dim OneCell As Range
 For Each OneCell In Selection.Cells
    If Right(OneCell.Value, Len(OneCell.Value) - InStrRev(OneCell.Value, " ")) <> _
       Right(OneCell.Offset(-1, 0).Value, Len(OneCell.Offset(-1, 0).Value) - InStrRev(OneCell.Offset(-1, 0).Value, " ")) Then
        OneCell.Offset(Rows.Count - OneCell.Row, 1).End(xlUp).Offset(1, 0).Value = _
        Right(OneCell.Value, Len(OneCell.Value) - InStrRev(OneCell.Value, " "))
    End If
    OneCell.Offset(Rows.Count - OneCell.Row, 1).End(xlUp).Offset(1, 0).Value = Left(OneCell.Value, InStrRev(OneCell.Value, " ") - 1)
 Next OneCell
End Sub

To copy to sheet "Result" without added rows.

Private Sub CommandButton1_Click()
    Dim LastRow As Long, RowNo As Long
    Dim wsData As Worksheet, wsResult As Worksheet

    Set wsData = Sheets("Data")
    Set wsResult = Sheets("Result")

    With wsData
        LastRow = .Range("C" & .Rows.Count).End(xlUp).Row
        .Range("B1:D" & LastRow).Copy wsResult.Range("B1")
    End With
    With wsResult
        For RowNo = LastRow To 2 Step -1
            If .Cells(RowNo, "D") <> .Cells(RowNo - 1, "D") Then
                .Cells(RowNo, "A") = .Cells(RowNo, "D")
            End If
        Next
        .Range("D1:D" & LastRow).Clear
    End With
End Sub

Hope this helps