Thanks for the help

[Buzzaro]

Wanted to thank you guys for your help with my first attempt at programming of any type. My wife came home one day and asked if I could do her a favor. I will never again say "sure" before I ask what the favor is. Turned out to be writing this macro. Its not elegant and probably rather clunky from a professional standpoint, but it works with all the examples I had to test with. What it does is take an excel file that has been imported from another database and puts it into a format that can be utilized much more easily to make reports and such. Here is .xls file with the before and after tabs showing what the macro does. I thank you guys for your help, its much appreciated.

Option Explicit
Function IsAlpha(MyString As String) As Integer
Dim LoopVar As Integer
Dim SingleChar As String

LoopVar = 1

If IsNull(MyString) Then
   IsAlpha = False
   Exit Function
End If

For LoopVar = 1 To Len(MyString)
   SingleChar = UCase(Mid$(MyString, LoopVar, 1))
   If SingleChar < "A" Or SingleChar > "Z" Then
      IsAlpha = False
      Exit Function
   End If
Next LoopVar

IsAlpha = True

End Function

Sub NewLogic()
Dim cyclecount As Variant
Dim StartCopy As Variant
Dim EndCopy As Variant
Dim CostCde(1 To 200, 1 To 200) As Variant
Dim PlnElv(1 To 50) As Variant
Dim PageNumber As Variant
Dim Count As Variant
Dim Plancount As Variant
Dim Cycle As String
Dim PE As Variant
Dim loopcount As Variant
Dim Found1 As Variant
Dim Found2 As Variant
Dim b As Variant
Dim c As Variant
Dim Codecount As Variant
Dim firstaddress As Variant
Dim destrange As Variant
Dim delrange As Variant
Dim cleanrange As Variant
Dim Code As Variant
Dim searchrange As Variant
Codecount = 1
Plancount = 1
PageNumber = 1
Rows("1:5").Delete
With Cells
    Set Found1 = .Find("58906A", LookIn:=xlValues)
    firstaddress = Found1.Address
    If Not Found1 Is Nothing Then
        Do
            Found1.Resize(7, 1).EntireRow.Delete
            Set Found1 = .Find("58906A", LookIn:=xlValues)
            On Error Resume Next
        Loop While Not Found1 Is Nothing And Found1.Address <> firstaddress
    End If
End With
With Cells
    Set Found2 = .Find("Cost Cde", LookIn:=xlValues)
    firstaddress = Found2.Address
    loopcount = 0
    If Not Found2 Is Nothing Then
        Do
            Count = 1
                Do While Not IsEmpty(Found2.Offset(0, Count))
                   If Not IsEmpty(Found2.Offset(0, Count)) And (Found2.Offset(0, Count)) = "Pln/Elv" Then
                       PE = (Found2.Offset(0, Count).Offset(2, 0))
                            Select Case IsEmpty(PlnElv(Plancount))
                                Case True
                                    If (Found2.Address) = firstaddress Then
                                        PlnElv(Plancount) = PE
                                    End If
                                Case False
                                    If (Found2.Address) = firstaddress Then
                                        Exit Do
                                    End If
                                    Do
                                       If PE = (PlnElv(Plancount)) Then
                                           Set delrange = Found2.Resize(5, 1).EntireRow
                                           Set Found2 = .FindNext(Found2)
                                           PE = (Found2.Offset(0, Count).Offset(2, 0))
                                           delrange.Delete
                                           Count = 1
                                           Exit Do
                                       End If
                                       If IsEmpty(PE) Then
                                           Found2.Offset(0, Count).Resize(300, 30).Delete
                                           Set delrange = Found2.Resize(5, 1).EntireRow
                                           Set Found2 = .FindNext(Found2)
                                           PE = (Found2.Offset(0, Count).Offset(2, 0))
                                           delrange.Delete
                                           Plancount = 1
                                           Count = 1
                                           Exit Do
                                       End If
                                       If IsEmpty(PlnElv(Plancount + 1)) Then
                                          Cells.Range(Found2.Offset(0, Count), Found2.Offset(0, Count).Offset(4, 0)).Copy Range("A3").End(xlToRight).Offset(0, 1)
                                          PlnElv(Plancount + 1) = PE
                                          Exit Do
                                       End If
                                       Plancount = Plancount + 1
                                   Loop While Not IsEmpty(PlnElv(Plancount))
                             End Select
                        Plancount = Plancount + 1
                    End If
                Count = Count + 1
                Loop
           Set Found2 = .FindNext(Found2)
           Plancount = 1
        Loop Until (Found2.Address) = firstaddress
    End If
End With
With Cells
Set b = .Find("total", LookIn:=xlValues)
Set searchrange = .Range("A" & b.Row, "A500")
End With
Cells(1, 1).Select
Do
        Do
          ActiveCell.Offset(1, 0).Select
           If IsNumeric(ActiveCell) And Not IsEmpty(ActiveCell) Then
                  Code = (ActiveCell)
                  With searchrange
                     Set c = .Find(Code, LookIn:=xlValues)
                     If Not c Is Nothing Then
                     Cells.Range(c.Offset(0, 2), c.Offset.End(xlToRight)).Copy Range(ActiveCell.Address).End(xlToRight).Offset(0, 1)
                     c.EntireRow.Delete
                     End If
                  End With
               
           End If
        Loop Until (ActiveCell.Row) = b.Row
    Cells(1, 1).Select
    cyclecount = cyclecount + 1
Loop Until cyclecount = 5
With Cells
Set c = .Find("Pln/Elv", LookIn:=xlValues)
    Do While Not c Is Nothing
    c.Value = c.Offset(2, 0).Value
    Set c = .FindNext(c)
    Loop
End With
Do While Not IsEmpty(b.Offset(4, 0))
    Set delrange = Range(b.Offset(3, 1), b.Offset.End(xlToRight)(7, 2))
    Set cleanrange = Range(b.Offset(3, 0), b.Offset.End(xlToRight)(7, 2))
    Set destrange = (b.Offset.End(xlToRight)(0, 2))
    delrange.Copy destrange
    cleanrange.Delete
Loop
Cells(1, 1).Select
End Sub