Extracting records from an excel list

I have a large spreadsheet with at least 6000 records (rows) and 5 columns.
The columns are as follows:

B5 C5 D5 E5 F5
Check# Vendor# Name Date Amount

From that first sheet, I need to create separate worksheets that would
retrieve all the records (from column B to column F) belonging to a vendor
(NAME: D5)
For example, I would highlight one of the cells containing the vendor name,
launch the macro and it would create the worksheet, give it the vendor's name
then list all the records on the worksheet.

Any help with this project will be gratefully appreciated.

Thanks in advance

Hey Leon,

Try this, I beleve this is what your looking for. Select the Vendor Name in
Column "D" and run this macro. I use a command button. Hope this helps.

Rick , (Fbks, Ak)



Option Explicit

Sub NewNameSheet()

Dim main As Worksheet, wksNew As Worksheet
Dim lrc As Long
Dim Name As String
Dim ishCt As Integer '' sheet count
Dim lnewRc As Long '' row postion on new sheet

Set main = Worksheets("sheet1") '' main sheet
lrc = 6 '' start row
Name = ActiveCell.Value

ishCt = Sheets.Count '' get number of worksheets
Worksheets.Add after:=Sheets(ishCt) '' add new sheet
Worksheets.Item(ishCt + 1).Name = Name '' rename sheet
Set wksNew = Worksheets(Name)

main.Range("B5:F5").Copy wksNew.Range("B5:F5") '' copy header

lnewRc = 6 '' beginning row for records


'' search for Name of vendor, then Copy data to new sheet

Do Until IsEmpty(main.Cells(lrc, "D"))
If main.Cells(lrc, "D") = Name Then
'' Copy Vendor Data, & paste to new sheet
main.Range("B" & lrc & ":F" & lrc).Copy wksNew.Range("B" & lnewRc &
":F" & lnewRc)
lnewRc = lnewRc + 1
End If
lrc = lrc + 1 '' next row to search
Loop

End Sub




"Leon" <[email protected]> wrote in message
news:[email protected]...
> I have a large spreadsheet with at least 6000 records (rows) and 5
columns.
> The columns are as follows:
>
> B5 C5 D5 E5 F5
> Check# Vendor# Name Date Amount
>
> From that first sheet, I need to create separate worksheets that would
> retrieve all the records (from column B to column F) belonging to a vendor
> (NAME: D5)
> For example, I would highlight one of the cells containing the vendor
name,
> launch the macro and it would create the worksheet, give it the vendor's
name
> then list all the records on the worksheet.
>
> Any help with this project will be gratefully appreciated.
>
> Thanks in advance
>

"Rick Hansen" wrote:

> Hey Leon,
>
> Try this, I beleve this is what your looking for. Select the Vendor Name in
> Column "D" and run this macro. I use a command button. Hope this helps.
>
> Rick , (Fbks, Ak)
>
>
>
> Option Explicit
>
> Sub NewNameSheet()
>
> Dim main As Worksheet, wksNew As Worksheet
> Dim lrc As Long
> Dim Name As String
> Dim ishCt As Integer '' sheet count
> Dim lnewRc As Long '' row postion on new sheet
>
> Set main = Worksheets("sheet1") '' main sheet
> lrc = 6 '' start row
> Name = ActiveCell.Value
>
> ishCt = Sheets.Count '' get number of worksheets
> Worksheets.Add after:=Sheets(ishCt) '' add new sheet
> Worksheets.Item(ishCt + 1).Name = Name '' rename sheet
> Set wksNew = Worksheets(Name)
>
> main.Range("B5:F5").Copy wksNew.Range("B5:F5") '' copy header
>
> lnewRc = 6 '' beginning row for records
>
>
> '' search for Name of vendor, then Copy data to new sheet
>
> Do Until IsEmpty(main.Cells(lrc, "D"))
> If main.Cells(lrc, "D") = Name Then
> '' Copy Vendor Data, & paste to new sheet
> main.Range("B" & lrc & ":F" & lrc).Copy wksNew.Range("B" & lnewRc &
> ":F" & lnewRc)
> lnewRc = lnewRc + 1
> End If
> lrc = lrc + 1 '' next row to search
> Loop
>
> End Sub
>
>
>
>
> "Leon" <[email protected]> wrote in message
> news:[email protected]...
> > I have a large spreadsheet with at least 6000 records (rows) and 5
> columns.
> > The columns are as follows:
> >
> > B5 C5 D5 E5 F5
> > Check# Vendor# Name Date Amount
> >
> > From that first sheet, I need to create separate worksheets that would
> > retrieve all the records (from column B to column F) belonging to a vendor
> > (NAME: D5)
> > For example, I would highlight one of the cells containing the vendor
> name,
> > launch the macro and it would create the worksheet, give it the vendor's
> name
> > then list all the records on the worksheet.
> >
> > Any help with this project will be gratefully appreciated.
> >
> > Thanks in advance
> >
>
>
> Hi Rick.

I'll try this right away and keep you posted

Thanks anyway.

"Rick Hansen" wrote:

> Hey Leon,
>
> Try this, I beleve this is what your looking for. Select the Vendor Name in
> Column "D" and run this macro. I use a command button. Hope this helps.
>
> Rick , (Fbks, Ak)
>
>
>
> Option Explicit
>
> Sub NewNameSheet()
>
> Dim main As Worksheet, wksNew As Worksheet
> Dim lrc As Long
> Dim Name As String
> Dim ishCt As Integer '' sheet count
> Dim lnewRc As Long '' row postion on new sheet
>
> Set main = Worksheets("sheet1") '' main sheet
> lrc = 6 '' start row
> Name = ActiveCell.Value
>
> ishCt = Sheets.Count '' get number of worksheets
> Worksheets.Add after:=Sheets(ishCt) '' add new sheet
> Worksheets.Item(ishCt + 1).Name = Name '' rename sheet
> Set wksNew = Worksheets(Name)
>
> main.Range("B5:F5").Copy wksNew.Range("B5:F5") '' copy header
>
> lnewRc = 6 '' beginning row for records
>
>
> '' search for Name of vendor, then Copy data to new sheet
>
> Do Until IsEmpty(main.Cells(lrc, "D"))
> If main.Cells(lrc, "D") = Name Then
> '' Copy Vendor Data, & paste to new sheet
> main.Range("B" & lrc & ":F" & lrc).Copy wksNew.Range("B" & lnewRc &
> ":F" & lnewRc)
> lnewRc = lnewRc + 1
> End If
> lrc = lrc + 1 '' next row to search
> Loop
>
> End Sub
>
>
>
>
> "Leon" <[email protected]> wrote in message
> news:[email protected]...
> > I have a large spreadsheet with at least 6000 records (rows) and 5
> columns.
> > The columns are as follows:
> >
> > B5 C5 D5 E5 F5
> > Check# Vendor# Name Date Amount
> >
> > From that first sheet, I need to create separate worksheets that would
> > retrieve all the records (from column B to column F) belonging to a vendor
> > (NAME: D5)
> > For example, I would highlight one of the cells containing the vendor
> name,
> > launch the macro and it would create the worksheet, give it the vendor's
> name
> > then list all the records on the worksheet.
> >
> > Any help with this project will be gratefully appreciated.
> >
> > Thanks in advance
> >
>
>
> Rick,
I get a "subscript out of range" on this line:
Set main = Worksheets("sheet1") '' main sheet

??

Hey Leon,
Replace "Sheet1" with the name of your spreadsheet name that has all of
yours records ons.
Also don't have any blanks rows between your first and last record on your
main spreadsheet.
If you do it'll stop the search for names. The "Isempty function is look
for the empty cell after the last record.
If you would like I'll email you my test spreadsheet program, here is my
email address [email protected]
Let me know if you need anymore help, Good Luck

Rick


"Leon" <[email protected]> wrote in message
news:[email protected]...
>
>
> "Rick Hansen" wrote:
>
> > Hey Leon,
> >
> > Try this, I beleve this is what your looking for. Select the Vendor Name
in
> > Column "D" and run this macro. I use a command button. Hope this helps.
> >
> > Rick , (Fbks, Ak)
> >
> >
> >
> > Option Explicit
> >
> > Sub NewNameSheet()
> >
> > Dim main As Worksheet, wksNew As Worksheet
> > Dim lrc As Long
> > Dim Name As String
> > Dim ishCt As Integer '' sheet count
> > Dim lnewRc As Long '' row postion on new sheet
> >
> > Set main = Worksheets("sheet1") '' main sheet
> > lrc = 6 '' start row
> > Name = ActiveCell.Value
> >
> > ishCt = Sheets.Count '' get number of worksheets
> > Worksheets.Add after:=Sheets(ishCt) '' add new sheet
> > Worksheets.Item(ishCt + 1).Name = Name '' rename sheet
> > Set wksNew = Worksheets(Name)
> >
> > main.Range("B5:F5").Copy wksNew.Range("B5:F5") '' copy header
> >
> > lnewRc = 6 '' beginning row for records
> >
> >
> > '' search for Name of vendor, then Copy data to new sheet
> >
> > Do Until IsEmpty(main.Cells(lrc, "D"))
> > If main.Cells(lrc, "D") = Name Then
> > '' Copy Vendor Data, & paste to new sheet
> > main.Range("B" & lrc & ":F" & lrc).Copy wksNew.Range("B" &
lnewRc &
> > ":F" & lnewRc)
> > lnewRc = lnewRc + 1
> > End If
> > lrc = lrc + 1 '' next row to search
> > Loop
> >
> > End Sub
> >
> >
> >
> >
> > "Leon" <[email protected]> wrote in message
> > news:[email protected]...
> > > I have a large spreadsheet with at least 6000 records (rows) and 5
> > columns.
> > > The columns are as follows:
> > >
> > > B5 C5 D5 E5 F5
> > > Check# Vendor# Name Date Amount
> > >
> > > From that first sheet, I need to create separate worksheets that
would
> > > retrieve all the records (from column B to column F) belonging to a
vendor
> > > (NAME: D5)
> > > For example, I would highlight one of the cells containing the vendor
> > name,
> > > launch the macro and it would create the worksheet, give it the
vendor's
> > name
> > > then list all the records on the worksheet.
> > >
> > > Any help with this project will be gratefully appreciated.
> > >
> > > Thanks in advance
> > >
> >
> >
> > Rick,
> I get a "subscript out of range" on this line:
> Set main = Worksheets("sheet1") '' main sheet
>
> ??

It worked !

Thanks a lot.
By the way, I should have known to change "sheets1" into the name of my
source worksheet.

Thanks anyway I really appreciate your help



"Rick Hansen" wrote:

> Hey Leon,
> Replace "Sheet1" with the name of your spreadsheet name that has all of
> yours records ons.
> Also don't have any blanks rows between your first and last record on your
> main spreadsheet.
> If you do it'll stop the search for names. The "Isempty function is look
> for the empty cell after the last record.
> If you would like I'll email you my test spreadsheet program, here is my
> email address [email protected]
> Let me know if you need anymore help, Good Luck
>
> Rick
>
>
> "Leon" <[email protected]> wrote in message
> news:[email protected]...
> >
> >
> > "Rick Hansen" wrote:
> >
> > > Hey Leon,
> > >
> > > Try this, I beleve this is what your looking for. Select the Vendor Name
> in
> > > Column "D" and run this macro. I use a command button. Hope this helps.
> > >
> > > Rick , (Fbks, Ak)
> > >
> > >
> > >
> > > Option Explicit
> > >
> > > Sub NewNameSheet()
> > >
> > > Dim main As Worksheet, wksNew As Worksheet
> > > Dim lrc As Long
> > > Dim Name As String
> > > Dim ishCt As Integer '' sheet count
> > > Dim lnewRc As Long '' row postion on new sheet
> > >
> > > Set main = Worksheets("sheet1") '' main sheet
> > > lrc = 6 '' start row
> > > Name = ActiveCell.Value
> > >
> > > ishCt = Sheets.Count '' get number of worksheets
> > > Worksheets.Add after:=Sheets(ishCt) '' add new sheet
> > > Worksheets.Item(ishCt + 1).Name = Name '' rename sheet
> > > Set wksNew = Worksheets(Name)
> > >
> > > main.Range("B5:F5").Copy wksNew.Range("B5:F5") '' copy header
> > >
> > > lnewRc = 6 '' beginning row for records
> > >
> > >
> > > '' search for Name of vendor, then Copy data to new sheet
> > >
> > > Do Until IsEmpty(main.Cells(lrc, "D"))
> > > If main.Cells(lrc, "D") = Name Then
> > > '' Copy Vendor Data, & paste to new sheet
> > > main.Range("B" & lrc & ":F" & lrc).Copy wksNew.Range("B" &
> lnewRc &
> > > ":F" & lnewRc)
> > > lnewRc = lnewRc + 1
> > > End If
> > > lrc = lrc + 1 '' next row to search
> > > Loop
> > >
> > > End Sub
> > >
> > >
> > >
> > >
> > > "Leon" <[email protected]> wrote in message
> > > news:[email protected]...
> > > > I have a large spreadsheet with at least 6000 records (rows) and 5
> > > columns.
> > > > The columns are as follows:
> > > >
> > > > B5 C5 D5 E5 F5
> > > > Check# Vendor# Name Date Amount
> > > >
> > > > From that first sheet, I need to create separate worksheets that
> would
> > > > retrieve all the records (from column B to column F) belonging to a
> vendor
> > > > (NAME: D5)
> > > > For example, I would highlight one of the cells containing the vendor
> > > name,
> > > > launch the macro and it would create the worksheet, give it the
> vendor's
> > > name
> > > > then list all the records on the worksheet.
> > > >
> > > > Any help with this project will be gratefully appreciated.
> > > >
> > > > Thanks in advance
> > > >
> > >
> > >
> > > Rick,
> > I get a "subscript out of range" on this line:
> > Set main = Worksheets("sheet1") '' main sheet
> >
> > ??
>
>
>

I'm glad I could help....

Rick


"Leon" <[email protected]> wrote in message
news:[email protected]...
> It worked !
>
> Thanks a lot.
> By the way, I should have known to change "sheets1" into the name of my
> source worksheet.
>
> Thanks anyway I really appreciate your help
>
>
>
> "Rick Hansen" wrote:
>
> > Hey Leon,
> > Replace "Sheet1" with the name of your spreadsheet name that has all
of
> > yours records ons.
> > Also don't have any blanks rows between your first and last record on
your
> > main spreadsheet.
> > If you do it'll stop the search for names. The "Isempty function is
look
> > for the empty cell after the last record.
> > If you would like I'll email you my test spreadsheet program, here is my
> > email address [email protected]
> > Let me know if you need anymore help, Good Luck
> >
> > Rick
> >
> >
> > "Leon" <[email protected]> wrote in message
> > news:[email protected]...
> > >
> > >
> > > "Rick Hansen" wrote:
> > >
> > > > Hey Leon,
> > > >
> > > > Try this, I beleve this is what your looking for. Select the Vendor
Name
> > in
> > > > Column "D" and run this macro. I use a command button. Hope this
helps.
> > > >
> > > > Rick , (Fbks, Ak)
> > > >
> > > >
> > > >
> > > > Option Explicit
> > > >
> > > > Sub NewNameSheet()
> > > >
> > > > Dim main As Worksheet, wksNew As Worksheet
> > > > Dim lrc As Long
> > > > Dim Name As String
> > > > Dim ishCt As Integer '' sheet count
> > > > Dim lnewRc As Long '' row postion on new sheet
> > > >
> > > > Set main = Worksheets("sheet1") '' main sheet
> > > > lrc = 6 '' start row
> > > > Name = ActiveCell.Value
> > > >
> > > > ishCt = Sheets.Count '' get number of
worksheets
> > > > Worksheets.Add after:=Sheets(ishCt) '' add new sheet
> > > > Worksheets.Item(ishCt + 1).Name = Name '' rename sheet
> > > > Set wksNew = Worksheets(Name)
> > > >
> > > > main.Range("B5:F5").Copy wksNew.Range("B5:F5") '' copy header
> > > >
> > > > lnewRc = 6 '' beginning row for
records
> > > >
> > > >
> > > > '' search for Name of vendor, then Copy data to new sheet
> > > >
> > > > Do Until IsEmpty(main.Cells(lrc, "D"))
> > > > If main.Cells(lrc, "D") = Name Then
> > > > '' Copy Vendor Data, & paste to new sheet
> > > > main.Range("B" & lrc & ":F" & lrc).Copy wksNew.Range("B" &
> > lnewRc &
> > > > ":F" & lnewRc)
> > > > lnewRc = lnewRc + 1
> > > > End If
> > > > lrc = lrc + 1 '' next row to search
> > > > Loop
> > > >
> > > > End Sub
> > > >
> > > >
> > > >
> > > >
> > > > "Leon" <[email protected]> wrote in message
> > > > news:[email protected]...
> > > > > I have a large spreadsheet with at least 6000 records (rows) and 5
> > > > columns.
> > > > > The columns are as follows:
> > > > >
> > > > > B5 C5 D5 E5 F5
> > > > > Check# Vendor# Name Date Amount
> > > > >
> > > > > From that first sheet, I need to create separate worksheets that
> > would
> > > > > retrieve all the records (from column B to column F) belonging to
a
> > vendor
> > > > > (NAME: D5)
> > > > > For example, I would highlight one of the cells containing the
vendor
> > > > name,
> > > > > launch the macro and it would create the worksheet, give it the
> > vendor's
> > > > name
> > > > > then list all the records on the worksheet.
> > > > >
> > > > > Any help with this project will be gratefully appreciated.
> > > > >
> > > > > Thanks in advance
> > > > >
> > > >
> > > >
> > > > Rick,
> > > I get a "subscript out of range" on this line:
> > > Set main = Worksheets("sheet1") '' main sheet
> > >
> > > ??
> >
> >
> >