Sub RunMe() Dim lRow As Integer lRow = Range("A1").End(xlDown).Row For Each cell In Range("A1:A" & lRow) On Error Resume Next If cell.Value <> cell.Offset(-1, 0).Value Then Range("F" & Rows.Count).End(xlUp).Offset(1, 0).Value = cell.Value Range("G" & Rows.Count).End(xlUp).Offset(1, 0).Value = cell.Offset(0, 1).Value Range("F" & Rows.Count).End(xlUp).Offset(1, 0).Value = cell.Value Range("G" & Rows.Count).End(xlUp).Offset(1, 0).Value = cell.Offset(0, 2).Value Range("F" & Rows.Count).End(xlUp).Offset(1, 0).Value = cell.Value Range("G" & Rows.Count).End(xlUp).Offset(1, 0).Value = cell.Offset(0, 3).Value Else Range("F" & Rows.Count).End(xlUp).Offset(1, 0).Value = cell.Value Range("G" & Rows.Count).End(xlUp).Offset(1, 0).Value = cell.Offset(0, 3).Value End If Next cell End Sub
Sub RunMe() Dim lRow, lRow2 As Long lRow = Range("A1").End(xlDown).Row For Each cell In Range("A1:A" & lRow) On Error Resume Next If cell.Value <> cell.Offset(-1, 0).Value Then lRow2 = Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Row Sheets("Sheet2").Range("A" & lRow2).Value = cell.Value Sheets("Sheet2").Range("B" & lRow2).Value = cell.Offset(0, 1).Value Sheets("Sheet2").Range("C" & lRow2).Value = cell.Offset(0, 2).Value Sheets("Sheet2").Cells(lRow2, Columns.Count).End(xlToLeft).Offset(0, 1).Value = cell.Offset(0, 3).Value Else Sheets("Sheet2").Cells(lRow2, Columns.Count).End(xlToLeft).Offset(0, 1).Value = cell.Offset(0, 3).Value End If Next cell 'Sheets("Sheet2").Rows(1).Delete End Sub
Sub RunMe() Dim mFind As Range Dim lRow, lRow2 As Integer Sheets("Initial").Select lRow = Range("C" & Rows.Count).End(xlUp).Row For Each cell In Range("C2:C" & lRow) Set mFind = Sheets("Deactivate").Columns("C").Find(cell.Value) If Not mFind Is Nothing Then If mFind.Offset(0, 3).Value <> "Y-C" Then With Sheets("Sheet2") lRow2 = .Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Row .Range("A" & lRow2).Value = mFind.Offset(0, 10).Value .Range("B" & lRow2).Value = mFind.Offset(0, 8).Value .Range("C" & lRow2).Value = mFind.Offset(0, 10).Value .Range("D" & lRow2).Value = mFind.Offset(0, -1).Value .Range("E" & lRow2).Value = mFind.Offset(0, 1).Value .Range("F" & lRow2).Value = mFind.Value End With End If End If Next cell End Sub
Sub sbCopyRangeToAnotherSheet() Sheets("MM Data").Range("A1").CurrentRegion.Copy _ Sheets("Outlook Mail Merge").Range("A1") End Sub
Sheets("Outlook Mail Merge").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
lRow = Range("A" & Rows.Count).End(xlUp).Row
lCol = Cells(1, Columns.Count).End(xlToLeft).Column
With Range("A1").CurrentRegion lRow = .Rows.Count lCol = .Columns.Count End With
Dim lRow As Long Dim lCol, x, y As Integer lRow = Range("A" & Rows.Count).End(xlUp).Row lCol = Range("A1").CurrentRegion.Columns.Count For x = lRow To 1 Step -1 y = Cells(x, Columns.Count).End(xlToLeft).Column If y < lCol Then lCol = y End If Next x
lCol = Range("A1").CurrentRegion.Columns.Count
Sub RunMe() Dim lRow As Long Dim lCol, x As Integer Sheets("YourSheetNameHere").Select lRow = Range("A" & Rows.Count).End(xlUp).Row For x = lRow To 1 Step -1 lCol = Cells(x, Columns.Count).End(xlToLeft).Column Sheets("DestinationSheet").Range("A" & x).Value = lCol Next x End Sub
So after the RunME operation, my dataset looks like this
x emailx
x nameofx
x 123
x 4456
x 67
y emaily
y nameofy
y 12
z emailz
z nameofz
z 45
z 7
And I need to make it to look like this
x emailx nameofx 123 4456 67
y emaily nameofy 12
z emailz nameofz 45 7
To get it to look like this, I currently would have to copy and paste the results of RunMe to another worksheet and execute this
Sub TransposeData()
Dim rFrom As Range
Dim rTo As Range
Dim iRows As Integer
Set rFrom = ActiveSheet.Range("A1") ' assumes data starts at A1 on active sheet
Set rTo = ActiveWorkbook.Worksheets.Add.Range("A1")
Do Until IsEmpty(rFrom.Value)
iRows = 1
Do While rFrom.Value = rFrom.Offset(iRows).Value
iRows = iRows+1
Loop
rTo.Value = rFrom.Value
rTo.Offset(,1).Resize(,iRows) = Application.Transpose(rFrom.Offset(,1).Resize(iRows))
Set rFrom=rFrom.Offset(iRows)
Set rTo=rTo.Offset(1)
Loop
End Sub
I want to bypass this step of copy and paste the RunMe result to another sheet.
I just want to run one macro to do two things.
Thanks in advance.