J
Jessica
I am trying to convert this file to create new worksheets within one
workbook instead of the origional multiple workbooks. I can import my
data and create the first report fine, I just can't get back into the
loop to create the second file. My syntax errors are on my
worksheets(send).activate and worksheets(home).activate. I would
really appreciate a few suggestions. thanks.
Global worksheets As Worksheet
Global home As String
Global send As String
Global csthold As String
Global sthold As String
Global tdte As String
Global fdte As String
Sub auto()
Set worksheets = Sheets.Add
' assigns the name of the worksheet on top to home
home = ActiveSheet.Name
' selects all the cells, delete's all the values and activates
cell A1
Cells.Select
Selection.Delete
Range("A1").Select
With ActiveSheet.QueryTables.Add(Connection:=Array(Array( _
"ODBC;DRIVER={Client Access ODBC Driver
(32-bit)};SYSTEM=ACIP400A;CMT=0;DBQ=brimiz;NAM=;DFT=0;DSP=0;TFT=0;TSP=0;DEC=0;XDYNAMIC=0;RECB"
_
), Array( _
"LOCK=0;BLOCKSIZE=8;SCROLLABLE=0;TRANSLATE=0;LAZYCLOSE=0;LIBVIEW=0;REMARKS=0;CONNTYPE=0;SORTTYPE=0;LANGUAGEID=ENU;SORTWEIGHT=0;P"
_
), Array("REFETCH=0;MGDSN=0;")), Destination:=Range("A1"))
.Sql = Array( _
"SELECT OPP6249.CSTNAM, OPP6249.STATE, OPP6249.BRANCH,
OPP6249.BRANCHID, OPP6249.JAN, OPP6249.FEB, OPP6249.MAR, OPP6249.APR,
OPP6249.MAY, OPP6249.JUN, OPP6249.JUL, OPP6249.AUG, OPP6249.SEP,
OPP6249.OCT" _
, _
", OPP6249.NOV, OPP6249.DEC, OPP6249.YTD, OPP6249.LY,
OPP6249.BEGDTE, OPP6249.ENDDTE" & Chr(13) & "" & Chr(10) & "FROM
ACIP400A.CCSDTA.OPP6249 OPP6249" _
)
.FieldNames = True
.RefreshStyle = xlInsertDeleteCells
.RowNumbers = False
.FillAdjacentFormulas = False
.RefreshOnFileOpen = False
.HasAutoFormat = True
.BackgroundQuery = True
.TablesOnlyFromHTML = True
.Refresh BackgroundQuery:=False
.SavePassword = True
.SaveData = True
End With
Sheets.Add
send = ActiveSheet.Name
worksheets(home).Activate
csthold = Range("A2").Value
fdte = Mid(Range("S2"), 5, 2) + "/" + Right(Range("S2"), 2) + "/"
+ Left(Range("S2"), 4)
tdte = Mid(Range("T2"), 5, 2) + "/" + Right(Range("T2"), 2) + "/"
+ Left(Range("T2"), 4)
Range("A2").Select
print_header
worksheets(home).Activate
run
worksheets(home).Activate
Cells.Select
Selection.Delete
Range("A1").Select
worksheets(send).Activate
End Sub
Sub run()
Dim row As String
Dim row2 As String
Dim branch As String
Dim branchid As String
Dim jan As String
Dim feb As String
Dim mar As String
Dim apr As String
Dim may As String
Dim jun As String
Dim jul As String
Dim aug As String
Dim sep As String
Dim oct As String
Dim nov As String
Dim dec As String
Dim ytd As String
Dim ly As String
While ActiveCell.Value <> ""
row = ActiveCell.row
If Range("A" + row).Value <> csthold Then
csthold = Range("A" + row).Value
sthold = Range("B" + row).Value
MsgBox (send)
worksheets(send).Activate
Cells.Select
Selection.Columns.AutoFit
Columns("Q:Q").Select
Selection.ColumnWidth = 6.5
Range("A1").Select
worksheets(home).Activate
Sheets.Add
send = ActiveWindow.Caption
worksheets(home).Activate
print_header
new_state
ElseIf Range("B" + row).Value <> sthold Then
sthold = Range("B" + row).Value
new_state
GoTo w
Else
branch = Range("C" + row).Value
branchid = Range("D" + row).Value
jan = Range("E" + row).Value
feb = Range("F" + row).Value
mar = Range("G" + row).Value
apr = Range("H" + row).Value
may = Range("I" + row).Value
jun = Range("J" + row).Value
jul = Range("K" + row).Value
aug = Range("L" + row).Value
sep = Range("M" + row).Value
oct = Range("N" + row).Value
nov = Range("O" + row).Value
dec = Range("P" + row).Value
ytd = Range("Q" + row).Value
ly = Range("R" + row).Value
worksheets(send).Activate
row2 = ActiveCell.row
Range("A" + row2).Value = branch
Range("B" + row2).Value = branchid
Range("C" + row2).Value = jan
Range("D" + row2).Value = feb
Range("E" + row2).Value = mar
Range("F" + row2).Value = apr
Range("G" + row2).Value = may
Range("H" + row2).Value = jun
Range("I" + row2).Value = jul
Range("J" + row2).Value = aug
Range("K" + row2).Value = sep
Range("L" + row2).Value = oct
Range("M" + row2).Value = nov
Range("N" + row2).Value = dec
Range("O" + row2).Value = ytd
Range("P" + row2).Value = ly
row2 = row2 + 1
Range("A" + row2).Select
worksheets(home).Activate
ActiveCell.Offset(1, 0).Select
End If
w:
Wend
worksheets(send).Activate
Cells.Select
Selection.Columns.AutoFit
Columns("Q:Q").Select
Selection.ColumnWidth = 6.5
Range("A1").Select
End Sub
Sub print_header()
Dim dte As String
Dim tme As String
dte = Date
tme = Time
worksheets(send).Activate
ActiveCell.FormulaR1C1 = "DATE: " + dte
Range("A2").Select
ActiveCell.FormulaR1C1 = "TIME: " + tme
Range("A3").Select
ActiveCell.FormulaR1C1 = csthold
Range("A5").Select
ActiveCell.FormulaR1C1 = "BRANCH"
Range("A6").Select
Columns("A:A").ColumnWidth = 21
Range("B5").Select
ActiveCell.FormulaR1C1 = "ID"
Columns("B:B").Select
Selection.ColumnWidth = 10
Columns("O:O").Select
Selection.ColumnWidth = 9.5
Columns("P").Select
Selection.ColumnWidth = 6.5
Columns("Q:Q").Select
Selection.ColumnWidth = 6.5
Columns("R:R").Select
Selection.ColumnWidth = 6.5
Range("C5").Select
ActiveCell.FormulaR1C1 = "JAN"
Range("D5").Select
ActiveCell.FormulaR1C1 = "FEB"
Range("E5").Select
ActiveCell.FormulaR1C1 = "MAR"
Range("F5").Select
ActiveCell.FormulaR1C1 = "APR"
Range("G5").Select
ActiveCell.FormulaR1C1 = "MAY"
Range("H5").Select
ActiveCell.FormulaR1C1 = "JUN"
Range("I5").Select
ActiveCell.FormulaR1C1 = "JUL"
Range("J5").Select
ActiveCell.FormulaR1C1 = "AUG"
Range("K5").Select
ActiveCell.FormulaR1C1 = "SEP"
Range("L5").Select
ActiveCell.FormulaR1C1 = "OCT"
Range("M5").Select
ActiveCell.FormulaR1C1 = "NOV"
Range("N5").Select
ActiveCell.FormulaR1C1 = "DEC"
Range("O5").Select
ActiveCell.FormulaR1C1 = Str(Year(Date)) + " YTD"
Range("P5").Select
ActiveCell.FormulaR1C1 = Str(Year(Date) - 1) + " YTD"
Range("Q1").Select
ActiveCell.FormulaR1C1 = "PROGRAM: OPB6249"
Range("Q1").Select
With Selection
.HorizontalAlignment = xlRight
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.ShrinkToFit = False
.MergeCells = False
End With
Range("B1").Select
ActiveCell.FormulaR1C1 = "American Ductile Iron Pipe"
Range("B2").Select
ActiveCell.FormulaR1C1 = "DISTRIBUTOR SALES FOR CORPORATE GROUPS"
Range("B3").Select
ActiveCell.FormulaR1C1 = fdte + " THROUGH " + tdte
Columns("B:B").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
End With
Columns("C").Select
Selection.NumberFormat = "#,##0"
Range("B1:N3").Select
With Selection
.HorizontalAlignment = xlCenterAcrossSelection
.VerticalAlignment = xlBottom
End With
Range("A1").Select
With ActiveSheet.PageSetup
.PrintTitleRows = "$1:$6"
.PrintTitleColumns = ""
End With
ActiveSheet.PageSetup.PrintArea = ""
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.2)
.RightMargin = Application.InchesToPoints(0.2)
.TopMargin = Application.InchesToPoints(1)
.BottomMargin = Application.InchesToPoints(1)
.HeaderMargin = Application.InchesToPoints(0.5)
.FooterMargin = Application.InchesToPoints(0.5)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperLetter
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 80
End With
Range("A5:R5").Select
With Selection
.HorizontalAlignment = xlCenter
End With
Range("A5").Select
End Sub
Sub new_state()
Dim rw As String
worksheets(send).Activate
rw = ActiveCell.row + 2
Range("A" + rw).Select
ActiveCell.Value = sthold
ActiveCell.Offset(1, 0).Select
worksheets(home).Activate
End Sub
workbook instead of the origional multiple workbooks. I can import my
data and create the first report fine, I just can't get back into the
loop to create the second file. My syntax errors are on my
worksheets(send).activate and worksheets(home).activate. I would
really appreciate a few suggestions. thanks.
Global worksheets As Worksheet
Global home As String
Global send As String
Global csthold As String
Global sthold As String
Global tdte As String
Global fdte As String
Sub auto()
Set worksheets = Sheets.Add
' assigns the name of the worksheet on top to home
home = ActiveSheet.Name
' selects all the cells, delete's all the values and activates
cell A1
Cells.Select
Selection.Delete
Range("A1").Select
With ActiveSheet.QueryTables.Add(Connection:=Array(Array( _
"ODBC;DRIVER={Client Access ODBC Driver
(32-bit)};SYSTEM=ACIP400A;CMT=0;DBQ=brimiz;NAM=;DFT=0;DSP=0;TFT=0;TSP=0;DEC=0;XDYNAMIC=0;RECB"
_
), Array( _
"LOCK=0;BLOCKSIZE=8;SCROLLABLE=0;TRANSLATE=0;LAZYCLOSE=0;LIBVIEW=0;REMARKS=0;CONNTYPE=0;SORTTYPE=0;LANGUAGEID=ENU;SORTWEIGHT=0;P"
_
), Array("REFETCH=0;MGDSN=0;")), Destination:=Range("A1"))
.Sql = Array( _
"SELECT OPP6249.CSTNAM, OPP6249.STATE, OPP6249.BRANCH,
OPP6249.BRANCHID, OPP6249.JAN, OPP6249.FEB, OPP6249.MAR, OPP6249.APR,
OPP6249.MAY, OPP6249.JUN, OPP6249.JUL, OPP6249.AUG, OPP6249.SEP,
OPP6249.OCT" _
, _
", OPP6249.NOV, OPP6249.DEC, OPP6249.YTD, OPP6249.LY,
OPP6249.BEGDTE, OPP6249.ENDDTE" & Chr(13) & "" & Chr(10) & "FROM
ACIP400A.CCSDTA.OPP6249 OPP6249" _
)
.FieldNames = True
.RefreshStyle = xlInsertDeleteCells
.RowNumbers = False
.FillAdjacentFormulas = False
.RefreshOnFileOpen = False
.HasAutoFormat = True
.BackgroundQuery = True
.TablesOnlyFromHTML = True
.Refresh BackgroundQuery:=False
.SavePassword = True
.SaveData = True
End With
Sheets.Add
send = ActiveSheet.Name
worksheets(home).Activate
csthold = Range("A2").Value
fdte = Mid(Range("S2"), 5, 2) + "/" + Right(Range("S2"), 2) + "/"
+ Left(Range("S2"), 4)
tdte = Mid(Range("T2"), 5, 2) + "/" + Right(Range("T2"), 2) + "/"
+ Left(Range("T2"), 4)
Range("A2").Select
print_header
worksheets(home).Activate
run
worksheets(home).Activate
Cells.Select
Selection.Delete
Range("A1").Select
worksheets(send).Activate
End Sub
Sub run()
Dim row As String
Dim row2 As String
Dim branch As String
Dim branchid As String
Dim jan As String
Dim feb As String
Dim mar As String
Dim apr As String
Dim may As String
Dim jun As String
Dim jul As String
Dim aug As String
Dim sep As String
Dim oct As String
Dim nov As String
Dim dec As String
Dim ytd As String
Dim ly As String
While ActiveCell.Value <> ""
row = ActiveCell.row
If Range("A" + row).Value <> csthold Then
csthold = Range("A" + row).Value
sthold = Range("B" + row).Value
MsgBox (send)
worksheets(send).Activate
Cells.Select
Selection.Columns.AutoFit
Columns("Q:Q").Select
Selection.ColumnWidth = 6.5
Range("A1").Select
worksheets(home).Activate
Sheets.Add
send = ActiveWindow.Caption
worksheets(home).Activate
print_header
new_state
ElseIf Range("B" + row).Value <> sthold Then
sthold = Range("B" + row).Value
new_state
GoTo w
Else
branch = Range("C" + row).Value
branchid = Range("D" + row).Value
jan = Range("E" + row).Value
feb = Range("F" + row).Value
mar = Range("G" + row).Value
apr = Range("H" + row).Value
may = Range("I" + row).Value
jun = Range("J" + row).Value
jul = Range("K" + row).Value
aug = Range("L" + row).Value
sep = Range("M" + row).Value
oct = Range("N" + row).Value
nov = Range("O" + row).Value
dec = Range("P" + row).Value
ytd = Range("Q" + row).Value
ly = Range("R" + row).Value
worksheets(send).Activate
row2 = ActiveCell.row
Range("A" + row2).Value = branch
Range("B" + row2).Value = branchid
Range("C" + row2).Value = jan
Range("D" + row2).Value = feb
Range("E" + row2).Value = mar
Range("F" + row2).Value = apr
Range("G" + row2).Value = may
Range("H" + row2).Value = jun
Range("I" + row2).Value = jul
Range("J" + row2).Value = aug
Range("K" + row2).Value = sep
Range("L" + row2).Value = oct
Range("M" + row2).Value = nov
Range("N" + row2).Value = dec
Range("O" + row2).Value = ytd
Range("P" + row2).Value = ly
row2 = row2 + 1
Range("A" + row2).Select
worksheets(home).Activate
ActiveCell.Offset(1, 0).Select
End If
w:
Wend
worksheets(send).Activate
Cells.Select
Selection.Columns.AutoFit
Columns("Q:Q").Select
Selection.ColumnWidth = 6.5
Range("A1").Select
End Sub
Sub print_header()
Dim dte As String
Dim tme As String
dte = Date
tme = Time
worksheets(send).Activate
ActiveCell.FormulaR1C1 = "DATE: " + dte
Range("A2").Select
ActiveCell.FormulaR1C1 = "TIME: " + tme
Range("A3").Select
ActiveCell.FormulaR1C1 = csthold
Range("A5").Select
ActiveCell.FormulaR1C1 = "BRANCH"
Range("A6").Select
Columns("A:A").ColumnWidth = 21
Range("B5").Select
ActiveCell.FormulaR1C1 = "ID"
Columns("B:B").Select
Selection.ColumnWidth = 10
Columns("O:O").Select
Selection.ColumnWidth = 9.5
Columns("P").Select
Selection.ColumnWidth = 6.5
Columns("Q:Q").Select
Selection.ColumnWidth = 6.5
Columns("R:R").Select
Selection.ColumnWidth = 6.5
Range("C5").Select
ActiveCell.FormulaR1C1 = "JAN"
Range("D5").Select
ActiveCell.FormulaR1C1 = "FEB"
Range("E5").Select
ActiveCell.FormulaR1C1 = "MAR"
Range("F5").Select
ActiveCell.FormulaR1C1 = "APR"
Range("G5").Select
ActiveCell.FormulaR1C1 = "MAY"
Range("H5").Select
ActiveCell.FormulaR1C1 = "JUN"
Range("I5").Select
ActiveCell.FormulaR1C1 = "JUL"
Range("J5").Select
ActiveCell.FormulaR1C1 = "AUG"
Range("K5").Select
ActiveCell.FormulaR1C1 = "SEP"
Range("L5").Select
ActiveCell.FormulaR1C1 = "OCT"
Range("M5").Select
ActiveCell.FormulaR1C1 = "NOV"
Range("N5").Select
ActiveCell.FormulaR1C1 = "DEC"
Range("O5").Select
ActiveCell.FormulaR1C1 = Str(Year(Date)) + " YTD"
Range("P5").Select
ActiveCell.FormulaR1C1 = Str(Year(Date) - 1) + " YTD"
Range("Q1").Select
ActiveCell.FormulaR1C1 = "PROGRAM: OPB6249"
Range("Q1").Select
With Selection
.HorizontalAlignment = xlRight
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.ShrinkToFit = False
.MergeCells = False
End With
Range("B1").Select
ActiveCell.FormulaR1C1 = "American Ductile Iron Pipe"
Range("B2").Select
ActiveCell.FormulaR1C1 = "DISTRIBUTOR SALES FOR CORPORATE GROUPS"
Range("B3").Select
ActiveCell.FormulaR1C1 = fdte + " THROUGH " + tdte
Columns("B:B").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
End With
Columns("C").Select
Selection.NumberFormat = "#,##0"
Range("B1:N3").Select
With Selection
.HorizontalAlignment = xlCenterAcrossSelection
.VerticalAlignment = xlBottom
End With
Range("A1").Select
With ActiveSheet.PageSetup
.PrintTitleRows = "$1:$6"
.PrintTitleColumns = ""
End With
ActiveSheet.PageSetup.PrintArea = ""
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.2)
.RightMargin = Application.InchesToPoints(0.2)
.TopMargin = Application.InchesToPoints(1)
.BottomMargin = Application.InchesToPoints(1)
.HeaderMargin = Application.InchesToPoints(0.5)
.FooterMargin = Application.InchesToPoints(0.5)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperLetter
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 80
End With
Range("A5:R5").Select
With Selection
.HorizontalAlignment = xlCenter
End With
Range("A5").Select
End Sub
Sub new_state()
Dim rw As String
worksheets(send).Activate
rw = ActiveCell.row + 2
Range("A" + rw).Select
ActiveCell.Value = sthold
ActiveCell.Offset(1, 0).Select
worksheets(home).Activate
End Sub