Solved: Pulling data

[Klartigue]

Please see the attached sheet, every fixed Income account corresponds to an Equity account and an Equity Income account. I need the data from sheet 1 to be pulled to sheet 2. such as by using the below code, but in a way that formats the data in a certain way(see sheet 2 of the attached sheet to see how i would like the data to come out.) The equity accounts need to be on one side and the Fixed Income on the other. But the Fixed Income account line in column D needs to be lined with the first equity line for each family grouping. Any ideas?


I get how to pull the data to another sheet, I just need a way to pull it in a way that keeps the family groupings together like I explained above and like it is on Sheet 2(which represents by desired results.)


Sub CorevsMuni()

Dim lastrow As Long
Dim i As Long
With ActiveSheet

lastrow = .Cells(.Rows.Count, "B").End(xlUp).Row
For i = 17 To lastrow

If .Cells(i, "A").Value = "Equity" Or _
.Cells(i, "A").Value = "Equity Income" Or _
.Cells(i, "A").Value = "Fixed Income" Then

With Range(.Cells(i, "A"), .Cells(i, "E")).Select
Selection.Cut
Sheets("Sheet2").Select
Range("A10000").End(xlUp).Offset(1, 0).Select
ActiveSheet.Paste


End With

End If

Next i

End With

End Sub

[Klartigue]

Sub Testdouble()

Dim lastrow As Long
Dim i As Long
With ActiveSheet

lastrow = .Cells(.Rows.Count, "B").End(xlUp).Row
For i = 17 To lastrow

If .Cells(i, "B").Value = "Equity" Or _
.Cells(i, "B").Value = "Equity Income" Then

With Range(.Cells(i, "B"), .Cells(i, "E")).Select
Selection.Cut
Sheets("Sheet 2").Select
Range("A10000").End(xlUp).Offset(1, 0).Select
ActiveSheet.Paste
Sheets("Sheet1").Select


End With

End If

Next i

End With

End Sub
Sub FI()

Dim lastrow As Long
Dim i As Long
With ActiveSheet

lastrow = .Cells(.Rows.Count, "B").End(xlUp).Row
For i = 17 To lastrow

If .Cells(i, "B").Value = "Fixed Income" Then

With Range(.Cells(i, "B"), .Cells(i, "E")).Select
Selection.Cut
Sheets("Sheet 2").Select
Range("G10000").End(xlUp).Offset(1, 0).Select
ActiveSheet.Paste
Sheets("Sheet1").Select


End With

End If

Next i

End With

End Sub


If you use this code for on the data in sheet 1, it pulls all the data to sheet 2 like i want. Now, For the SUB FI code, is there a way to have the data paste in every other row in Column G, starting in row 1, becasue I think that would work to line up the accounts correctly.

So in this part : Range("G10000").End(xlUp).Offset(1, 0).Select
ActiveSheet.Paste

alter it to have the next data line pasted not in the next row, but in the nextrow+1

[Klartigue]

Sub FI()

Dim lastrow As Long
Dim i As Long
With ActiveSheet

lastrow = .Cells(.Rows.Count, "B").End(xlUp).Row
For i = 17 To lastrow

If .Cells(i, "B").Value = "Fixed Income" Then

With Range(.Cells(i, "B"), .Cells(i, "E")).Select
Selection.Cut
Sheets("Sheet 2").Select
Range("G10000").End(xlUp).Offset(2, 0).Select
ActiveSheet.Paste
Sheets("Sheet1").Select


End With

End If

Next i

End With

End Sub


This Sub FI code gets me much closer to my desired solution. Except it is placing my data starting in G3. I need it to place my data starting in G2 so the FI data matches up with the first row of the equity stuff. Is there a way to alter the offset (2,0)?

[CatDaddy]

Sub CorevsMuni()

Dim eq() As Variant
Dim fI() As Variant
Dim r As Long
ActiveWorkbook.Sheets(1).Activate
ReDim eq(0 To 0) As Variant
ReDim fI(0 To 0) As Variant
For Each cell In Range("B17:B" & Range("B" & Rows.Count).End(xlUp).Row)
Select Case cell.Text
Case "Equity"
ReDim Preserve eq(0 To (UBound(eq) + 1))
eq(UBound(eq)) = cell.Row
Case "Equity Income"
ReDim Preserve eq(0 To (UBound(eq) + 1))
eq(UBound(eq)) = cell.Row
Case "Fixed Income"
ReDim Preserve fI(0 To (UBound(fI) + 1))
fI(UBound(fI)) = cell.Row
End Select
Next cell
r = 1
For i = LBound(eq) + 1 To UBound(eq)
Range("D" & eq(i) & ":E" & eq(i)).Copy Destination:=Sheets("Sheet 2").Range("A" & r)
r = r + 1
Next i
r = 1
For i = LBound(fI) + 1 To UBound(fI)
Range("D" & fI(i) & ":E" & fI(i)).Copy Destination:=Sheets("Sheet 2").Range("D" & r)
r = r + 2
Next i
End Sub

[Klartigue]

Thanks!