| Excel Workbook | ||||||
|---|---|---|---|---|---|---|
| D | E | F | G | |||
| 2 | 91000 | -120,403 | -10,035 | NEW CAR SALES | ||
| 3 | 91000D | 11,526 | 989 | NEW CAR SALES | ||
| 4 | 91000K | -7,500 | -500 | NEW CAR SALES | ||
| 5 | 91001 | -235,618 | -34,453 | NEW CAR SALES | ||
| 6 | 91001D | 19,927 | 5,332 | NEW CAR SALES | ||
| 7 | 91001K | -21,333 | -5,333 | NEW CAR SALES | ||
| 8 | 91002 | -290,974 | -20,167 | NEW CAR SALES | ||
Sheet1 | ||||||
| Excel 2007 | ||||||
|---|---|---|---|---|---|---|
| D | E | F | G | |||
| 1 | Account Numbers | Title E | Title F | Account Numbers | ||
| 2 | 91000 | -120,403 | -10,035 | NEW CAR SALES | ||
| 3 | ||||||
| 4 | 91000D | 11,526 | 989 | NEW CAR SALES | ||
| 5 | ||||||
| 6 | 91000K | -7,500 | -500 | NEW CAR SALES | ||
| 7 | 91001 | -235,618 | -34,453 | NEW CAR SALES | ||
| 8 | ||||||
| 9 | 91001D | 19,927 | 5,332 | NEW CAR SALES | ||
| 10 | 91001K | -21,333 | -5,333 | NEW CAR SALES | ||
| 11 | 91002 | -290,974 | -20,167 | NEW CAR SALES | ||
| 12 | ||||||
TB | ||||||
| Excel 2007 | |||
|---|---|---|---|
| G | |||
| 1 | Account Numbers | ||
| 2 | |||
| 3 | |||
| 4 | |||
| 5 | |||
| 6 | |||
| 7 | |||
| 8 | |||
| 9 | |||
Extract | |||
| Excel 2007 | |||
|---|---|---|---|
| G | |||
| 1 | Account Numbers | ||
| 2 | 91000 | ||
| 3 | 91000D | ||
| 4 | 91000K | ||
| 5 | 91001 | ||
| 6 | 91001D | ||
| 7 | 91001K | ||
| 8 | 91002 | ||
| 9 | |||
Extract | |||
Option Explicit
Sub GetNewCarSales()
Dim c As Range, n As Long, o As Variant, i As Long, nr As Long
Application.ScreenUpdating = False
With Sheets("TB")
n = Application.CountIf(.Columns(7), "NEW CAR SALES")
If n = 0 Then
MsgBox "There are no 'NEW CAR SALES' in column G - macro terminated!"
Exit Sub
ElseIf n > 0 Then
ReDim o(1 To n, 1 To 1)
For Each c In .Range("G2", .Range("G" & Rows.Count).End(xlUp))
If c = "NEW CAR SALES" Then
i = i + 1
o(i, 1) = c.Offset(, -3)
End If
Next c
End If
End With
With Sheets("Extract")
nr = .Cells(Rows.Count, 7).End(xlUp).Row + 1
.Cells(nr, 7).Resize(UBound(o, 1)) = o
.Columns(7).AutoFit
.Activate
End With
Application.ScreenUpdating = True
End Sub
=IFERROR(INDEX(Sheet1!$A$2:$A$100,
SMALL(IF(Sheet1!$B$2:$B$100=$A$1,
ROW(Sheet1!$B$2:$B$100)-ROW(Sheet1!$B$2)+1),
ROWS($A$3:A3))),"")
