VBA Macro to create new worksheet, charts, etc.

Hi,

I need a macro to create the following worksheets and charts from an Excel data set:

Three (3) worksheets (already created manually in attached Excel file):

1. Chart Data.
(a) Column A in Chart Data is always numbered 1 - 600 (50 years x 12 mos/yr).
(b) Column I and column Y data sets (from Prod_Month) created in Chart Data. Each data set can be identified and collated with column F in Prod_Month (API) which is unique for each dataset.

2. Rate vs. Month - plot of Daily Gas (col. Y in Prod_Month) vs. Months (col. A in Chart Data).

3. Rate vs. Time - plot of Daily Gas (col. Y in Prod_Month) vs. Calender Time (col. B et. al. in Chart Data)

At a minimum, could someone help me create the Chart Data worksheet from the data in PROD_MONTH? Charting all the columns takes time from Chart Data but any data manipulation macro(s) help.

Thanks,

Jim15

have you tried to create a macro yourself?
Because this sounds like something you just record and fiddle with and it'll work for you...

Below is code to format your data, but before I go any further with this, can you paste this code into your Prod_Month sheet, run it and confirm whether that's how your data should be arranged? If so, then I'll put the chart code together ...

Option Explicit

Sub CreateChartData()
Dim wsh As Worksheet
Dim strTargetName As String, strGroupName As String
Dim strLeaseCol As String, strWellCol As String, strMonthCol As String, strGasCol As String, strAPI_Col As String
Dim intFirstRow As Integer, intLastCol As Integer
Dim lngLastRow As Long, lngStartRow As Long, lngEndRow As Long
Dim intCountGroups As Integer
Dim i As Long, j As Long

    'initialise:
    strTargetName = "CHART DATA"
    'you can set these dynamically if you like; I've just assumed they're static for now:
    strLeaseCol = "D"
    strWellCol = "E"
    strAPI_Col = "F"
    strMonthCol = "I"
    strGasCol = "Y"
    intFirstRow = 2
    
    'establish boundaries:
    lngLastRow = Cells.SpecialCells(xlCellTypeLastCell).Row
    intLastCol = Cells.SpecialCells(xlCellTypeLastCell).Column
    
    'if target sheet doesn't exist - create it; if it does - clear it:
    For Each wsh In Worksheets
        If wsh.Name = strTargetName Then GoTo ClearTarget
    Next wsh
    ThisWorkbook.Worksheets.Add after:=Worksheets.Count
    Worksheets(Worksheets.Count).Name = strTargetName

ClearTarget:
    Worksheets(strTargetName).Cells.Clear
    
    '1-600 in the first col:
    For i = 1 To 600
        Worksheets(strTargetName).Range("A" & i).Value = i
    Next i
    
    'sort the data by lease name, well number & month:
    Range(Cells(intFirstRow, 1), Cells(lngLastRow, intLastCol)).Sort _
        key1:=Range(strLeaseCol & intFirstRow), Order1:=xlAscending, _
        key2:=Range(strWellCol & intFirstRow), Order2:=xlAscending, _
        key3:=Range(strMonthCol & intFirstRow), Order2:=xlAscending, _
        MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal, DataOption2:=xlSortTextAsNumbers, DataOption3:=xlSortNormal, _
        header:=xlYes

    'generate the target data for each unique API:
    lngStartRow = intFirstRow
    lngEndRow = 0
    intCountGroups = 0
    For i = intFirstRow To lngLastRow
        If Range(strAPI_Col & intFirstRow - 1).Offset(i - 1, 0) = Range(strAPI_Col & intFirstRow - 1).Offset(i, 0) Then
            'keep looking:
        Else
            'next group found:
            intCountGroups = intCountGroups + 1
            strGroupName = Range(strLeaseCol & i).Text & Range(strWellCol & i).Text
            lngEndRow = i
            Worksheets(strTargetName).Range("A" & intFirstRow - 1).Offset(0, intCountGroups * 2 + 1).Value = strGroupName
            Range(strMonthCol & lngStartRow & ":" & strMonthCol & lngEndRow).Copy
            Worksheets(strTargetName).Range("A" & intFirstRow).Offset(0, intCountGroups * 2).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
            Range(strGasCol & lngStartRow & ":" & strGasCol & lngEndRow).Copy
            Worksheets(strTargetName).Range("A" & intFirstRow).Offset(0, intCountGroups * 2 + 1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
            lngStartRow = lngEndRow + 1
        End If
    Next i
    Worksheets(strTargetName).Columns.AutoFit
End Sub

If this is not right, then let me know where I've gone wrong & I'll take another look. Cheers, MM.

you're very welcome Jim ... "don't let the b$%^&ds get you down"

Of course, this only does the chart data prep; let me know if you'd like me to also code the chart part of your question ...

Sure no probs ... in the middle of something so may be an hour or so ...

... spoke too soon .. I've just looked at your chart layouts and since in the full set of data you've got 11 groups of data, your charts in this format are going to look a real mess ... are you sure that's how you want them? Perhaps you could run my code in your book and manually configure the charts so I can confirm how you want them to look?

Hi Jim .. yep - that's do-able ... It also allows you to have them all or just those of interest (I knew what you meant )... So if you can manually configure the charts how you want them set up, and reattach your workbook, I'll write a little routine to change the datasets based on which ones a user selects. Just make sure the charts are set up as you want to see them (e.g. I noticed one of them had a logorithmic scale which of course will give an error if zeroes or negative values are in the data). If it really is a log scale, then it will change how I can define the range. Also - can you explain how you use the 1-600 scale in defining the x axis?

Hi jim ... charting solution is attached. It is triggered when you leave the chart data sheet and it looks to see if any of the well names in row 1 are selected; so if you select the whole of row 1, all well wills be plotted; if you select individual or multiple cells, then those are plotted when you leave the sheet. Of course, you can change whatever triggers the plotting - use a button or whatever suits. Code for the charting bit is below.

Option Explicit
Option Base 1

Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
Dim rngWellsToChart As Range, rngWellDataRange As Range, cel As Range
Dim strTargetSheet As String, strChart1 As String, strChart2 As String
Dim str50yrRangeAddress As String
Dim cht As Chart
Dim varWells As Variant, varWellData As Variant, varWellMonths As Variant
Dim i As Integer
Dim lngLastDataRow As Long, lngLastWellRow As Long
Dim booValidHeaderFound As Boolean

    On Error GoTo ErrorExit

    strTargetSheet = ActiveSheet.Name
    strChart1 = "RATE VS. MONTH"
    strChart2 = "RATE VS. DATE"
    booValidHeaderFound = False
    
    If Sh.Name = "CHART DATA" Then
        Application.ScreenUpdating = False
        Application.EnableEvents = False
        Application.DisplayAlerts = False
        Sh.Activate
        lngLastDataRow = Sh.Cells.SpecialCells(xlCellTypeLastCell).Row + 1
        str50yrRangeAddress = Sh.Range(Cells(2, 1), Cells(Sh.Cells(lngLastDataRow, 1).End(xlUp).Row, 1)).Address(ReferenceStyle:=xlR1C1)
        
        Set rngWellsToChart = ActiveWindow.RangeSelection
        i = 1
        ReDim varWells(i)
        ReDim varWellData(i)
        ReDim varWellMonths(i)
        For Each cel In rngWellsToChart
            If cel.Row = 1 And cel.Text <> "" Then
                ReDim Preserve varWells(i)
                ReDim Preserve varWellData(i)
                ReDim Preserve varWellMonths(i)
                varWells(i) = cel.Text
                lngLastWellRow = Sh.Cells(lngLastDataRow, cel.Column).End(xlUp).Row
                Set rngWellDataRange = Range(Cells(cel.Row + 1, cel.Column), Cells(lngLastWellRow, cel.Column))
                varWellData(i) = rngWellDataRange.Address(ReferenceStyle:=xlR1C1)
                varWellMonths(i) = rngWellDataRange.Offset(0, 1).Address(ReferenceStyle:=xlR1C1)
                i = i + 1
                booValidHeaderFound = True
            End If
        Next cel
        If booValidHeaderFound = False Then GoTo NormalExit
        
        For Each cht In Charts
            If cht.Name = strChart1 Then
                'delete any existing data plotted:
                While cht.SeriesCollection.Count > 0
                    cht.SeriesCollection(cht.SeriesCollection.Count).Delete
                Wend
                'add each selected well as new data:
                For i = LBound(varWells) To UBound(varWells)
                    cht.SeriesCollection.NewSeries
                    cht.SeriesCollection(i).Name = "=""" & varWells(i) & """"
                    cht.SeriesCollection(i).XValues = "='" & Sh.Name & "'!" & str50yrRangeAddress
                    cht.SeriesCollection(i).Values = "='" & Sh.Name & "'!" & varWellData(i)
                Next i
            ElseIf cht.Name = strChart2 Then
                'delete any existing data plotted:
                While cht.SeriesCollection.Count > 0
                    cht.SeriesCollection(cht.SeriesCollection.Count).Delete
                Wend
                'add each selected well as new data:
                For i = LBound(varWells) To UBound(varWells)
                    cht.SeriesCollection.NewSeries
                    cht.SeriesCollection(i).Name = "=""" & varWells(i) & """"
                    cht.SeriesCollection(i).XValues = "='" & Sh.Name & "'!" & varWellMonths(i)
                    cht.SeriesCollection(i).Values = "='" & Sh.Name & "'!" & varWellData(i)
                Next i
            Else
                'do nothing:
            End If
        Next cht
    End If
    
    GoTo NormalExit
    
ErrorExit:
    MsgBox (Err.Description)
    
NormalExit:

    Sheets(strTargetSheet).Activate
    Application.ScreenUpdating = True
    Application.EnableEvents = True

End Sub

Hope that helps. MM.

MM,

I reviewed the VBA Macro and the charting function plots the incorrect date with the data. It should be selecting the Month-YY column immediately before the data instead of after.

Do you know which line of VBA tells what column to use or can you fix?

Thanks,

Jim15

Hi Jim - yep, sorry about that ... the offending line is:

varWellMonths(i) = rngWellDataRange.Offset(0, 1).Address(ReferenceStyle:=xlR1C1)

... which of course should be:

varWellMonths(i) = rngWellDataRange.Offset(0, -1).Address(ReferenceStyle:=xlR1C1)

I had the offset to the right instead of the left - doh! Have corrected it for you and it's in the attached.