macro to create multiple tabs

B

biglb79

Active Member
Joined
Oct 17, 2007
Messages
299
does anyone know how to write a macro that could do the following? data is contained in columns A:AT and the number or rows will always vary. Row 1 is the header row and will need to be included on every tab as well

1.) create a separate tab labeled as bad debt data and it only includes everything in column I (GL Account) with account number 14000-00, so all other rows would be deleted

2.) a tab labeled as ISNP data and it deletes every row in column I except account number 42875-00

3.) the final tab is labeled Sequestered data and it deletes all rows that do not have an X or XR under transaction type (column S)


Thanks in advance and I hope I explained everything well
 

Excel Facts

Do you hate GETPIVOTDATA?
Prevent GETPIVOTDATA. Select inside a PivotTable. In the Analyze tab of the ribbon, open the dropown next to Options and turn it off
Sort by date Sort by votes
try this on a copy of your workbook to see if it does what you want:
VBA Code: 
Sub TEST()
Dim badt() As Variant
Dim ISNP As Variant
Dim Seq As Variant

lastrow = Cells(Rows.Count, "A").End(xlUp).Row
lastcol = 46  ' column AT
 inarr = Range(Cells(1, 1), Cells(lastrow, lastcol))
ReDim badt(1 To lastrow, 1 To lastcol)
ReDim ISNP(1 To lastrow, 1 To lastcol)
ReDim Seq(1 To lastrow, 1 To lastcol)
bcnt = 2
icnt = 2
scnt = 2
'copy headers
For j = 1 To lastcol
badt(1, j) = inarr(1, j)
ISNP(1, j) = inarr(1, j)
Seq(1, j) = inarr(1, j)
Next j
  For i = 1 To lastrow
   If inarr(i, 9) = "14000-00" Then
    For j = 1 To lastcol
     badt(bcnt, j) = inarr(i, j)
    Next j
    bcnt = bcnt + 1
   End If
  
   If inarr(i, 9) = "42875-00" Then
    For j = 1 To lastcol
     ISNP(icnt, j) = inarr(i, j)
    Next j
    icnt = icnt + 1
   End If
  
   If inarr(i, 19) = "X" Or inarr(i, 19) = "XR" Then
    For j = 1 To lastcol
     Seq(scnt, j) = inarr(i, j)
    Next j
    scnt = scnt + 1
   End If
 Next i
 Worksheets.Add
 ActiveSheet.Name = "Bad Debt Data"
 Range(Cells(1, 1), Cells(bcnt, lastcol)) = badt
 Worksheets.Add
 ActiveSheet.Name = "ISNP Data"
 Range(Cells(1, 1), Cells(icnt, lastcol)) = ISNP
 Worksheets.Add
 ActiveSheet.Name = "Sequestered Data"
 Range(Cells(1, 1), Cells(scnt, lastcol)) = Seq
 
End Sub
 
Upvote 0
Solution
offthelip said:
try this on a copy of your workbook to see if it does what you want:
VBA Code: 
Sub TEST()
Dim badt() As Variant
Dim ISNP As Variant
Dim Seq As Variant

lastrow = Cells(Rows.Count, "A").End(xlUp).Row
lastcol = 46  ' column AT
 inarr = Range(Cells(1, 1), Cells(lastrow, lastcol))
ReDim badt(1 To lastrow, 1 To lastcol)
ReDim ISNP(1 To lastrow, 1 To lastcol)
ReDim Seq(1 To lastrow, 1 To lastcol)
bcnt = 2
icnt = 2
scnt = 2
'copy headers
For j = 1 To lastcol
badt(1, j) = inarr(1, j)
ISNP(1, j) = inarr(1, j)
Seq(1, j) = inarr(1, j)
Next j
  For i = 1 To lastrow
   If inarr(i, 9) = "14000-00" Then
    For j = 1 To lastcol
     badt(bcnt, j) = inarr(i, j)
    Next j
    bcnt = bcnt + 1
   End If
 
   If inarr(i, 9) = "42875-00" Then
    For j = 1 To lastcol
     ISNP(icnt, j) = inarr(i, j)
    Next j
    icnt = icnt + 1
   End If
 
   If inarr(i, 19) = "X" Or inarr(i, 19) = "XR" Then
    For j = 1 To lastcol
     Seq(scnt, j) = inarr(i, j)
    Next j
    scnt = scnt + 1
   End If
 Next i
 Worksheets.Add
 ActiveSheet.Name = "Bad Debt Data"
 Range(Cells(1, 1), Cells(bcnt, lastcol)) = badt
 Worksheets.Add
 ActiveSheet.Name = "ISNP Data"
 Range(Cells(1, 1), Cells(icnt, lastcol)) = ISNP
 Worksheets.Add
 ActiveSheet.Name = "Sequestered Data"
 Range(Cells(1, 1), Cells(scnt, lastcol)) = Seq
 
End Sub
Click to expand...
that worked perfectly!!! thank you so much!
 
Upvote 0
offthelip said:
try this on a copy of your workbook to see if it does what you want:
VBA Code: 
Sub TEST()
Dim badt() As Variant
Dim ISNP As Variant
Dim Seq As Variant

lastrow = Cells(Rows.Count, "A").End(xlUp).Row
lastcol = 46  ' column AT
 inarr = Range(Cells(1, 1), Cells(lastrow, lastcol))
ReDim badt(1 To lastrow, 1 To lastcol)
ReDim ISNP(1 To lastrow, 1 To lastcol)
ReDim Seq(1 To lastrow, 1 To lastcol)
bcnt = 2
icnt = 2
scnt = 2
'copy headers
For j = 1 To lastcol
badt(1, j) = inarr(1, j)
ISNP(1, j) = inarr(1, j)
Seq(1, j) = inarr(1, j)
Next j
  For i = 1 To lastrow
   If inarr(i, 9) = "14000-00" Then
    For j = 1 To lastcol
     badt(bcnt, j) = inarr(i, j)
    Next j
    bcnt = bcnt + 1
   End If
 
   If inarr(i, 9) = "42875-00" Then
    For j = 1 To lastcol
     ISNP(icnt, j) = inarr(i, j)
    Next j
    icnt = icnt + 1
   End If
 
   If inarr(i, 19) = "X" Or inarr(i, 19) = "XR" Then
    For j = 1 To lastcol
     Seq(scnt, j) = inarr(i, j)
    Next j
    scnt = scnt + 1
   End If
 Next i
 Worksheets.Add
 ActiveSheet.Name = "Bad Debt Data"
 Range(Cells(1, 1), Cells(bcnt, lastcol)) = badt
 Worksheets.Add
 ActiveSheet.Name = "ISNP Data"
 Range(Cells(1, 1), Cells(icnt, lastcol)) = ISNP
 Worksheets.Add
 ActiveSheet.Name = "Sequestered Data"
 Range(Cells(1, 1), Cells(scnt, lastcol)) = Seq
 
End Sub
Click to expand...
so it worked perfectly on my original file, but then when I deleted all of the tabs (except for the original data tab) and tried running it again
biglb79 said:
that worked perfectly!!! thank you so much!
Click to expand...
I have another question. I wanted to take those data tabs and create pivot tables. I thought I could just record a macro doing everything I wanted but there's an error. do you know why this is? I bolded out the highlighted area when I clicked debug

Sub Pivot_tables()
'
' Pivot_tables Macro
'

'
Range("A1").Select
Sheets(Array("Sequestered Data", "ISNP Data", "Bad Debt Data")).Select
Sheets("Sequestered Data").Activate
Cells.Select
Cells.EntireColumn.AutoFit
Range("A1:AT1").Select
Selection.Font.Bold = True
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.249977111117893
.PatternTintAndShade = 0
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Cells.Select
Cells.EntireColumn.AutoFit
Range("B1").Select
Sheets("Sequestered Data").Select
Columns("K:K").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("K1").Select
ActiveCell.FormulaR1C1 = "Sequestered category"
Range("K2").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-1],'sequestered key'!C[-10]:C[-9],2,0)"
Range("K2").Select
Selection.AutoFill Destination:=Range("K2:K19969")
Range("K2:K19969").Select
Range("B1").Select
Sheets.Add
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
"Sequestered Data!R1C1:R19969C47", Version:=xlPivotTableVersion15). _
CreatePivotTable TableDestination:="Sheet6!R3C1", TableName:="PivotTable18" _
, DefaultVersion:=xlPivotTableVersion15
Sheets("Sheet6").Select
Cells(3, 1).Select
With ActiveSheet.PivotTables("PivotTable18").PivotFields("Facility Name")
.Orientation = xlRowField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable18").PivotFields("Sequestered category" _
)
.Orientation = xlRowField
.Position = 2
End With
ActiveSheet.PivotTables("PivotTable18").AddDataField ActiveSheet.PivotTables( _
"PivotTable18").PivotFields("Amount"), "Sum of Amount", xlSum
Columns("B:B").Select
Selection.Style = "Comma"
Sheets("Sheet6").Select
Sheets("Sheet6").Name = "sequestered pivot table"
Range("D31").Select
Sheets("ISNP Data").Select
Sheets.Add
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
"ISNP Data!R1C1:R33C46", Version:=xlPivotTableVersion15).CreatePivotTable _
TableDestination:="Sheet7!R3C1", TableName:="PivotTable19", DefaultVersion _
:=xlPivotTableVersion15
Sheets("Sheet7").Select
Cells(3, 1).Select
With ActiveSheet.PivotTables("PivotTable19").PivotFields("Facility Name")
.Orientation = xlRowField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable19").PivotFields("JE Name")
.Orientation = xlRowField
.Position = 2
End With
ActiveSheet.PivotTables("PivotTable19").AddDataField ActiveSheet.PivotTables( _
"PivotTable19").PivotFields("Units"), "Sum of Units", xlSum
ActiveSheet.PivotTables("PivotTable19").AddDataField ActiveSheet.PivotTables( _
"PivotTable19").PivotFields("Amount"), "Sum of Amount", xlSum
Columns("C:C").Select
Selection.Style = "Comma"
Range("C17").Select
Sheets("Sheet7").Select
Sheets("Sheet7").Name = "ISNP pivot table"
Sheets("Bad Debt Data").Select
Sheets.Add
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
"Bad Debt Data!R1C1:R232C46", Version:=xlPivotTableVersion15). _
CreatePivotTable TableDestination:="Sheet8!R3C1", TableName:="PivotTable20" _
, DefaultVersion:=xlPivotTableVersion15
Sheets("Sheet8").Select
Cells(3, 1).Select
With ActiveSheet.PivotTables("PivotTable20").PivotFields("Facility Name")
.Orientation = xlRowField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable20").PivotFields("Payer Type")
.Orientation = xlRowField
.Position = 2
End With
ActiveSheet.PivotTables("PivotTable20").AddDataField ActiveSheet.PivotTables( _
"PivotTable20").PivotFields("Amount"), "Sum of Amount", xlSum
Columns("B:B").Select
Selection.Style = "Comma"
Sheets("Sheet8").Select
Sheets("Sheet8").Name = "bad debt pivot table"
Range("C4").Select
End Sub
 
Upvote 0
This is an entirely different question and since I virtually never use pivot tables, because I find it easier to write a bit of VBA, I can't answer your question , so you would be best to start a new thread
 
Upvote 0
You must log in or register to reply here.

Similar threads

B
  • Solved
Recording macro pivot table error
Replies
2
Views
1K
biglb79
B
V
  • Question
Help Needed for a Macro to Transpose
Replies
6
Views
155
alansidman
A
R
  • Question
Selecting Multiple Rows in Excel and Create Email with attachment
Replies
1
Views
286
RYL
R
B
  • Solved
vba code to give next Sunday date for pasted data
Replies
2
Views
202
bh24524
B
S
  • Question
Macro: flatten sheet, delete other tab, and save
Replies
4
Views
223
steallan
S

Forum statistics

Threads
1,215,335
Messages
6,124,327
Members
449,155
Latest member
ravioli44

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top