I have data that I am importing regularly and the number of lines of the
data is highly variable. I have written code that first inserts a column of
data I need for my Y axis, then the second part of my code should select
the my X and Y range and change the graph accordingly then thirdly modify
the limits of the major axis to the nearest largest multiple of 10 of the
data. My sections 2 and three are not working properly. If you can help
with any part I would be very grateful.
Here is my code:
Sub Tip_Elevation()
'
' Tip_Elevation Macro
' Insert Tip Elevation Depth (Ft)
'
' Keyboard Shortcut: Ctrl+Shift+I
'Insert column needed for Y Axis
Cells.find(What:="Test").Activate
Selection.Offset(0, -1).Select
ActiveCell.FormulaR1C1 = "TIP"
Down
ActiveCell.FormulaR1C1 = "Elevation"
Down
ActiveCell.FormulaR1C1 = "Depth"
Down
ActiveCell.FormulaR1C1 = "(ft)"
Down
ActiveCell.FormulaR1C1 = "'-----"
Down
ActiveCell.FormulaR1C1 = "=-RC[1]"
Down
Selection.Offset(0, 1).Activate
5
If ActiveCell > 0 Then GoTo 10
GoTo 15
10
Selection.Offset(0, -1).Select
ActiveCell.FormulaR1C1 = "=-RC[1]"
Down
Selection.Offset(0, 1).Activate
GoTo 5
15
' modify_graph Macro
'
'Determine the number of rows are in data
n = 0 'number of rows in graph data
Cells.find(What:="Test").Activate 'Find Column with Test
Selection.Offset(5, 0).Select 'Select fist number of column
20
If ActiveCell > 0 Then GoTo 25 'If number exists go to 15
GoTo 30 'End counter
25
n = n + 1 'Add counter
Down
GoTo 20 'Continue counter
30 'Determine Y Vaule Range
Dim RngYVal As Range
'Cells.FindNext(After:=ActiveCell).Activate
'Cells.FindNext(After:=ActiveCell).Activate
'Cells.find(What:="Tip").Activate
Cells.find(What:="TIP", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
True, SearchFormat:=False).Activate
Selection.Offset(5, 0).Select
Set RngYVal = Range(ActiveCell, ActiveCell.Offset(n, 0))
40 'Determine X Value Range
Dim RngXVal As Range
Cells.find(What:="TIP", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
True, SearchFormat:=False).Activate
Selection.Offset(5, 6).Select
Set RngXVal = Range(ActiveCell, ActiveCell.Offset(n, 0))
50 'Set graph Data
Sheets("Curve").Select
ActiveChart.SeriesCollection(1).XValues = RngXVal
ActiveChart.SeriesCollection(1).Values = RngYVal
60 'Modify Axis Limits
61 'Find Max Depth - factor of 10
Dim Depth As Integer
ActiveSheet.Previous.Select 'Selects the Previous Sheet
Cells.find(What:="TIP", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
True, SearchFormat:=False).Activate
Selection.Offset(n + 5, 0).Select
Depth = ActiveCell
Depth = Application.RoundUp(lngRHDataRows / 10, 0)
Depth = Depth * 10
ActiveCell.Offset(1, 0) = Depth
62 'Find Max Load - factor of 10
Dim Load As Integer
Selection.Offset(-1, 6).Select
Load = ActiveCell
Load = Application.RoundUp(lngRHDataRows / 10, 0)
Load = Depth * 10
ActiveCell.Offset(1, 0) = Load
65 'Change Graph Axis limits
Sheets("Curve").Select
ActiveSheet.ChartObjects("Chart 7").Activate
ActiveChart.Axes(xlValue).Select
ActiveChart.PlotArea.Select
ActiveChart.Axes(xlValue).Select
ActiveChart.Axes(xlValue).MinimumScale = Depth
ActiveChart.Axes(xlCategory).Select
ActiveChart.Axes(xlCategory).MaximumScale = Load
End Sub
Thank you for all and any help!
--
FORUM RULES (986+ members already BANNED for violation)
1) Use concise, accurate thread titles. Poor thread titles, like Please Help,
Urgent, Need Help, Formula Problem, Code Problem, and Need Advice will not get
quick attention or may not be answered.
2) Don't post a question in the thread of another member.
3) Don't post questions regarding breaking or bypassing any security measure.
4) Acknowledge the responses you receive, good or bad.
5) Cross-promotion of, or links to, forums competitive to this forum in
signatures are prohibited.
NOTE : Don't ever post personal or confidential data in a workbook. Forum
owners and members are not responsible for any loss.
------------------------------------------------------------------------------------------------------
To post to this group, send email to excel-macros@googlegroups.com
To unsubscribe, send a blank email to excel-macros+unsubscr...@googlegroups.com
