VBA Code help

[jlclyde]

I have 6 columns of data and I am trying to transfer them to another
sheet. I need to have them grouped by their catalog number.
For instance
A = Item Number
B = Catalog #
C = Quantity
D = Unit Price
E = Amount to credit
F = Reason Code

Each row contains one item, with one cata log and so on.
If there are 9 items with 3 different catalog numbers, I woudl like to
be able to concatenate the item #s together if the catalog numbers are
the same and move them to another sheet. So it woudl add 3 rows to
the worksheet that they are being moved to. If you can show me some
code to do the item numbers, I can work our how to do the rest.

Thank you in advance,
Jay

 

[Bernie Deitrick]

Jay,

The macro below will do what you want. But, you could simply apply a data filter to your database
and use the dropdown at the top of the catalog column to show only one catalog at a time - a much
better approach.

For the macro, select one cell within your database, run the macro, and when asked

What column # within database to use as key?

just answer

2

HTH,
Bernie
MS Excel MVP


Sub ExportDatabaseToSeparateSheets()
'Export is based on the value in the desired column
Dim myCell As Range
Dim mySht As Worksheet
Dim myName As String
Dim myArea As Range
Dim myShtName As String
Dim KeyCol As Integer

myShtName = ActiveSheet.Name
KeyCol = InputBox("What column # within database to use as key?")


Set myArea = ActiveCell.CurrentRegion.Columns(KeyCol).Offset(1, 0).Cells

Set myArea = myArea.Resize(myArea.Rows.Count - 1, 1)

For Each myCell In myArea
On Error GoTo NoSheet
myName = Worksheets(myCell.Value).Name
GoTo SheetExists:
NoSheet:
Set mySht = Worksheets.Add(Before:=Worksheets(1))
mySht.Name = myCell.Value
With myCell.CurrentRegion
.AutoFilter Field:=KeyCol, Criteria1:=myCell.Value
'These lines copy everything - including extra header rows
' and any SUBTOTAL formulas separated by blank row
'Uncomment them to use them
' myCell.Parent.Cells.SpecialCells(xlCellTypeVisible).Copy
' mySht.Range("A1").PasteSpecial xlPasteValues


'These are the default - only copy the database values
.SpecialCells(xlCellTypeVisible).Copy _
mySht.Range("A1")
mySht.Cells.EntireColumn.AutoFit
.AutoFilter
End With
Resume
SheetExists:
Next myCell

End Sub

 

[jlclyde]

Jay,

The macro below will do what you want.  But, you could simply apply a data filter to your database
and use the dropdown at the top of the catalog column to show only one catalog at a time - a much
better approach.

For the macro, select one cell within your database, run the macro, and when asked

What column # within database to use as key?

just answer

2

HTH,
Bernie
MS Excel MVP

Sub ExportDatabaseToSeparateSheets()
'Export is based on the value in the desired column
Dim myCell As Range
Dim mySht As Worksheet
Dim myName As String
Dim myArea As Range
Dim myShtName As String
Dim KeyCol As Integer

myShtName = ActiveSheet.Name
KeyCol = InputBox("What column # within database to use as key?")

Set myArea = ActiveCell.CurrentRegion.Columns(KeyCol).Offset(1, 0).Cells

Set myArea = myArea.Resize(myArea.Rows.Count - 1, 1)

For Each myCell In myArea
On Error GoTo NoSheet
myName = Worksheets(myCell.Value).Name
GoTo SheetExists:
NoSheet:
Set mySht = Worksheets.Add(Before:=Worksheets(1))
mySht.Name = myCell.Value
With myCell.CurrentRegion
    .AutoFilter Field:=KeyCol, Criteria1:=myCell.Value
'These lines copy everything - including extra header rows
' and any SUBTOTAL formulas separated by blank row
'Uncomment them to use them
'  myCell.Parent.Cells.SpecialCells(xlCellTypeVisible).Copy
'      mySht.Range("A1").PasteSpecial xlPasteValues

'These are the default - only copy the database values
   .SpecialCells(xlCellTypeVisible).Copy _
        mySht.Range("A1")
    mySht.Cells.EntireColumn.AutoFit
    .AutoFilter
End With
Resume
SheetExists:
Next myCell

End Sub








- Show quoted text -

I do nto want to make a new sheet for each catalog number. I want to
copy all catalog types from the data base to another workbook and
concatenate the item numbers.

A = Item#
B= Catalog

Row 1 is A = 1234 and B = 2
Row 2 is A = 1235 and B = 3
Row 3 is A = 1236 and B = 2

I need the code to find each of the different catalog numbers and move
it to another workbook so the new workbook woudl look like this
Row 1 is A = 1234, 1236 and B = 2
Row 2 is A = 1235 and B = 3

I hope this paints a better picture of what I am trying to accomplish.

thanks,
Jay

 

[Bernie Deitrick]

Jay,

Try this - I wasn't sure what to do with columns 3 through 6, so I just summed them....

HTH,
Bernie
MS Excel MVP


Sub TryNow()
Dim myR As Range
Dim myC1 As Range
Dim myC2 As Range
Dim myV As String
Dim myRow As Long

myRow = Cells(Rows.Count, 1).End(xlUp)(4).Row

On Error GoTo Done
While True
myV = ""
Set myR = Range("A1").CurrentRegion
myR.AutoFilter Field:=2, Criteria1:=Range("B2").Value
Set myC1 = myR.Offset(1, 0).Resize(myR.Rows.Count - 1)

For Each myC2 In myC1.Columns(1).SpecialCells(xlCellTypeVisible)
If myV = "" Then
myV = myC2.Value
ElseIf myC2.Value <> "" Then
myV = myV & ", " & myC2.Value
End If
Next myC2
Cells(myRow, 1).Value = myV
Cells(myRow, 2).Value = Range("B2").Value
With Range("C" & myRow).Resize(, 4)
.FormulaR1C1 = "=SUBTOTAL(9,R2C:R[-4]C)"
.Value = .Value
End With
myC1.EntireRow.Delete
myRow = Cells(Rows.Count, 1).End(xlUp)(2).Row
ActiveSheet.ShowAllData
Wend

Done:
Range("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Range("A1").CurrentRegion.AutoFilter
End Sub

***********************************************8888

I do nto want to make a new sheet for each catalog number. I want to
copy all catalog types from the data base to another workbook and
concatenate the item numbers.

A = Item#
B= Catalog

Row 1 is A = 1234 and B = 2
Row 2 is A = 1235 and B = 3
Row 3 is A = 1236 and B = 2

I need the code to find each of the different catalog numbers and move
it to another workbook so the new workbook woudl look like this
Row 1 is A = 1234, 1236 and B = 2
Row 2 is A = 1235 and B = 3

I hope this paints a better picture of what I am trying to accomplish.

thanks,
Jay