Sub ReorgDataV4()
' hiker95, 06/29/2015, ME852326
Dim w1 As Worksheet, wo As Worksheet
Dim a As Variant, o As Variant
Dim i As Long, j As Long
Dim lr As Long, lc As Long, n As Long, c As Long
Application.ScreenUpdating = False
Set w1 = Sheets("PowerFAIDS_Scholarship_Export") '<-- you can change the sheet name here
With w1
.Activate
lr = .Cells(Rows.Count, 1).End(xlUp).Row
lc = .Cells(1, 1).End(xlToRight).Column
a = .Range(.Cells(1, 1), .Cells(lr, lc))
n = Application.CountA(.Range("B2:J" & lr)) / 3
ReDim o(1 To n, 1 To 9)
End With
For i = 2 To UBound(a, 1)
For c = 2 To 10 Step 3
If a(i, c) = vbEmpty And a(i, c + 1) = vbEmpty And a(i, c + 2) = vbEmpty Then
'do nothing
Else
j = j + 1
o(j, 1) = a(i, 1): o(j, 2) = a(i, c): o(j, 3) = a(i, c + 1): o(j, 4) = a(i, c + 2)
o(j, 5) = a(i, 11): o(j, 6) = a(i, 12): o(j, 7) = a(i, 13): o(j, 8) = a(i, 14): o(j, 9) = a(i, 15)
End If
Next c
Next i
If Not Evaluate("ISREF(Output!A1)") Then Worksheets.Add(After:=w1).Name = "Output"
Set wo = Sheets("Output")
With wo
.UsedRange.Clear
.Cells(1, 1).Resize(, 9).Value = Array("Social Security", "Scholarship Code", "Scholarship Award", _
"Scholarship Award Amount", "First Name", "Middle Name", _
"Last Name", "ADM-DT", "BDFW-DT")
.Cells(2, 1).Resize(UBound(o, 1), UBound(o, 2)) = o
.Columns(1).Resize(, UBound(o, 2)).AutoFit
.Activate
End With
Application.ScreenUpdating = True
End Sub