martinctc
10/21/2016 - 11:42 AM

Formats your data for plotting scatter diagrams

Formats your data for plotting scatter diagrams

Option Explicit
Sub ScatterPlotter()
    
'This VBA Excel code formats a three-column table (with header, data labels on lefter-most column) into a format suitable for creating a scatter diagram in Microsoft Excel / PowerPoint.

If MsgBox("When you begin, ensure that: (1) Col A is populated with desired horizontal labels, begin from A2 (downwards); (2) Col B is populated with desired x-axis values, begin from B2 (downwards); (3) Col C is populated with desired y-axis values, begin from C2 (downwards). Do you wish to continue?", vbYesNo) = vbNo Then Exit Sub

Dim activewb As Workbook
Dim origin_sheet As String
Dim oldsheet, newsheet As Worksheet
Dim i, n, m, CountBlank As Integer
Dim Cell As String
Dim Continue As Boolean

Application.ScreenUpdating = False
Continue = True

Set activewb = Application.ActiveWorkbook
origin_sheet = activewb.ActiveSheet.Name
'activewb.Worksheets(origin_sheet).Copy After:=Worksheets(origin_sheet)
'ActiveSheet.Name = "Formatted"
activewb.Sheets.Add(After:=Sheets(Sheets.Count)).Name = "Formatted"
Set newsheet = activewb.Sheets("Formatted")
Set oldsheet = activewb.Sheets(origin_sheet)
oldsheet.Activate

n = 1
CountBlank = 0

Do While Continue = True
    Cell = Cells(n, 1).Value
        If Cell = Empty Then
            CountBlank = CountBlank + 1
        Else: CountBlank = 0
        
        End If
        
        If CountBlank > 30 Then Continue = False
        
n = n + 1

Loop

m = n - CountBlank - 1

Debug.Print CountBlank
Debug.Print n
Debug.Print m


'Update all the worksheet names below as appropriate (in double quotations)
'Check cell locations are correct before running macro


For i = 2 To m
'Deal with horizontal headers
newsheet.Cells(1, i).Value = oldsheet.Cells(i, 1)
'Deal with diagonal data in scatter diagram
newsheet.Cells(i, i).Value = oldsheet.Cells(i, 3)
'Deal with first column in scatter diagram
newsheet.Cells(i, 1).Value = oldsheet.Cells(i, 2)

Next i

newsheet.Activate

Range(Cells(2, 1), Cells(m, m)).Style = "Percent"

MsgBox "Yup, that's done"

End Sub