Frankenstein's script

**Metrazal** · 09-29-2014, 08:37 AM

Ok, I have a script that I pieced together and much like Frankenstein's Monster it is not behaving the way I want it to. The main issue I have is data is not always transfered to some of my sheets. Specifically, even when an "x" is in a row in columns L, M, N, or P the information I want copied to a sheet is not. Any help or guidance would be appreciated.

Thanks,

Met

Sub Lone2()

Sheets("ITEM TRACKING").Select
Range("A8").Select
IM = ActiveCell.Value
Workbooks("Numbers for Item Add_Change Tracking Spreadsheet v111512C.xlsx").Save
Workbooks("Numbers for Item Add_Change Tracking Spreadsheet v111512C.xlsx").Close

Workbooks.Open ("C:\Test Directory Structure\Add-In Forms\UPLOAD SPREADSHEET.xlsx")

Windows("" & IM & ".xlsx").Activate
Sheets("REQUESTER").Select

Dim aa, ab, ac, ad, ae, af, ag, ah, i As Long, y, ba&, bb&, bc&, bd&, be&, bf&, bg&, bh&

  With Worksheets("REQUESTER")
    y = .Range("F9:DN" & .cells.Find("*", , , , xlByRows, xlPrevious).Row)
 End With

  ReDim aa(1 To UBound(y), 1 To UBound(y, 2))
  ReDim ab(1 To UBound(y), 1 To UBound(y, 2))
  ReDim ac(1 To UBound(y), 1 To UBound(y, 2))
  ReDim ad(1 To UBound(y), 1 To UBound(y, 2))
  ReDim ae(1 To UBound(y), 1 To UBound(y, 2))
  ReDim af(1 To UBound(y), 1 To UBound(y, 2))
  ReDim ag(1 To UBound(y), 1 To UBound(y, 2))
  ReDim ah(1 To UBound(y), 1 To UBound(y, 2))
  
    
    
     For i = 1 To UBound(y, 1)
        If y(i, 1) = "x" Then
                ba = ba + 1
                aa(ba, 2) = y(i, 63)
                aa(ba, 3) = y(i, 64)
                aa(ba, 4) = y(i, 82)
                aa(ba, 5) = y(i, 83)
                aa(ba, 6) = y(i, 70)
                aa(ba, 7) = y(i, 71)
                aa(ba, 8) = y(i, 72)
                aa(ba, 10) = y(i, 84)
                aa(ba, 11) = y(i, 85)
                aa(ba, 12) = y(i, 73)
                aa(ba, 13) = y(i, 74)
                aa(ba, 14) = y(i, 94)
                aa(ba, 15) = y(i, 95)
                aa(ba, 16) = y(i, 96)
                aa(ba, 17) = y(i, 97)
                aa(ba, 18) = y(i, 75)
                aa(ba, 19) = y(i, 76)
                aa(ba, 20) = y(i, 77)
                aa(ba, 21) = y(i, 98)
                aa(ba, 22) = y(i, 99)
                aa(ba, 23) = y(i, 100)
                aa(ba, 24) = y(i, 101)
                aa(ba, 25) = y(i, 78)
                aa(ba, 26) = y(i, 79)
                aa(ba, 27) = y(i, 80)
                aa(ba, 28) = y(i, 102)
                aa(ba, 29) = y(i, 103)
                aa(ba, 30) = y(i, 104)
                aa(ba, 31) = y(i, 105)
                aa(ba, 32) = y(i, 81)
                aa(ba, 33) = y(i, 88)
                aa(ba, 34) = y(i, 65)
                aa(ba, 35) = y(i, 86)
                aa(ba, 36) = y(i, 87)
                           
          End If
      
     
        If y(i, 2) = "x" Then GoTo IC11C
        If y(i, 3) = "x" Then GoTo IC11C
        If y(i, 4) = "x" Then GoTo IC11C
        If y(i, 5) = "x" Then GoTo IC11C
        If y(i, 11) = "x" Then GoTo IC11C
        GoTo Lastline:
                
        
IC11C:
                bb = bb + 1
                ab(bb, 2) = y(i, 63)
                ab(bb, 3) = y(i, 64)
                ab(bb, 4) = y(i, 82)
                ab(bb, 5) = y(i, 70)
                ab(bb, 6) = y(i, 71)
                ab(bb, 7) = y(i, 72)
                ab(bb, 8) = y(i, 65)
          
         
        If y(i, 1) = "x" Then GoTo PO13
        If y(i, 1) = "x" Then GoTo PO13
        If y(i, 2) = "x" Then GoTo PO13
        If y(i, 4) = "x" Then GoTo PO13
        If y(i, 5) = "x" Then GoTo PO13
        If y(i, 6) = "x" Then GoTo PO13
        If y(i, 7) = "x" Then GoTo PO13
        GoTo Lastline:
        
PO13:

                bc = bc + 1
                ac(bc, 2) = y(i, 63)
                ac(bc, 4) = y(i, 67)
                ac(bc, 5) = y(i, 68)
                ac(bc, 6) = y(i, 70)
                ac(bc, 7) = y(i, 71)
                ac(bc, 8) = y(i, 72)
                
                
        If y(i, 1) = "x" Then GoTo PO256
        If y(i, 2) = "x" Then GoTo PO256
        If y(i, 4) = "x" Then GoTo PO256
        If y(i, 5) = "x" Then GoTo PO256
        If y(i, 6) = "x" Then GoTo PO256
        If y(i, 7) = "x" Then GoTo PO256
        GoTo Lastline:
                
                
PO256:

                bd = bd + 1
                ad(bd, 2) = y(i, 113)
                ad(bd, 4) = y(i, 68)
                ad(bd, 5) = y(i, 63)
                ad(bd, 6) = y(i, 110)
                ad(bd, 7) = y(i, 108)
                ad(bd, 8) = y(i, 88)
          
          
        If y(i, 8) = "x" Then GoTo PO256HOLD
        If y(i, 11) = "x" Then GoTo PO256HOLD
        GoTo Lastline:
                    
PO256HOLD:

                be = be + 1
                ae(be, 2) = y(i, 58)
                ae(be, 3) = y(i, 59)
                ae(be, 4) = y(i, 15)
               
        
        If y(i, 9) = "x" Then GoTo PRICEONLY
        GoTo Lastline:
          
                  
          
PRICEONLY:
          
                bf = bf + 1
                af(bf, 2) = y(i, 113)
                af(bf, 4) = y(i, 107)
                af(bf, 5) = y(i, 68)
                af(bf, 6) = y(i, 63)
                af(bf, 7) = y(i, 110)
                af(bf, 8) = y(i, 108)
          
          
         If y(i, 11) = "x" Then GoTo PO13INACT
         GoTo Lastline:
          
          
          
PO13INACT:
          
          
                bg = bg + 1
                ag(bg, 2) = y(i, 63)
                ag(bg, 4) = y(i, 67)
                ag(bg, 5) = y(i, 68)
                ag(bg, 6) = y(i, 64)
                
          
          
         If y(i, 11) = "x" Then GoTo IC11INACT
         GoTo Lastline:
          
          
          
IC11INACT:
          
                bh = bh + 1
                ah(bh, 2) = y(i, 63)
                ah(bh, 3) = y(i, 64)
                ah(bh, 4) = y(i, 65)
                            
          
          
Lastline:
                 
     Next
  Windows("UPLOAD SPREADSHEET.xlsx").Activate
  With Worksheets("IC11 ADD")
    .UsedRange.Offset(5).ClearContents
    If ba > 0 Then .Range("A6").Resize(ba, UBound(y, 2)).Value = aa
 End With
  
   With Worksheets("IC11 CHANGE")
     .UsedRange.Offset(5).ClearContents
     If bb > 0 Then .Range("A6").Resize(bb, UBound(y, 2)).Value = ab
   End With

   With Worksheets("PO13")
     .UsedRange.Offset(5).ClearContents
     If bc > 0 Then .Range("A6").Resize(bc, UBound(y, 2)).Value = ac
   End With

   With Worksheets("PO25.6 NEW AGREEMENT")
     .UsedRange.Offset(5).ClearContents
     If bd > 0 Then .Range("A6").Resize(bd, UBound(y, 2)).Value = ad
   End With

   With Worksheets("PO25.6 HOLD")
     .UsedRange.Offset(5).ClearContents
     If be > 0 Then .Range("A6").Resize(be, UBound(y, 2)).Value = ae
   End With

   With Worksheets("PRICE ONLY")
     .UsedRange.Offset(5).ClearContents
     If bf > 0 Then .Range("A6").Resize(bf, UBound(y, 2)).Value = af
   End With
   
   With Worksheets("P013 INACT")
     .UsedRange.Offset(5).ClearContents
     If bg > 0 Then .Range("A6").Resize(bg, UBound(y, 2)).Value = ag
   End With
   
   With Worksheets("IC11 INACT")
     .UsedRange.Offset(5).ClearContents
     If bh > 0 Then .Range("A6").Resize(bh, UBound(y, 2)).Value = ah
   End With
   
If Sheets("IC11 CHANGE").Range("$B$6").Value > 0 Then Sheets("IC11 CHANGE").Tab.ColorIndex = 6

If Sheets("PO13").Range("$B$6").Value > 0 Then Sheets("PO13").Tab.ColorIndex = 6

If Sheets("PO25.6 NEW AGREEMENT").Range("$B$6").Value > 0 Then Sheets("PO25.6 NEW AGREEMENT").Tab.ColorIndex = 6

If Sheets("PO25.6 HOLD").Range("$B$6").Value > 0 Then Sheets("PO25.6 HOLD").Tab.ColorIndex = 6

If Sheets("PRICE ONLY").Range("$B$6").Value > 0 Then Sheets("PRICE ONLY").Tab.ColorIndex = 6

If Sheets("IC11 ADD").Range("$B$6").Value > 0 Then Sheets("IC11 ADD").Tab.ColorIndex = 6

If Sheets("P013 INACT").Range("$B$6").Value > 0 Then Sheets("P013 INACT").Tab.ColorIndex = 6

If Sheets("IC11 INACT").Range("$B$6").Value > 0 Then Sheets("IC11 INACT").Tab.ColorIndex = 6
   

End Sub

**AB33** · 09-29-2014, 09:13 AM

Met,
Monster is understatement.
Please note I have not tested the code and some of the if statement are duplicates or wrong.
This is merely to show you it can be done with ifs statements.
If I were, I would have split the code in to 2-3 codes.

Sub Lone2()

Sheets("ITEM TRACKING").Select
Range("A8").Select
IM = ActiveCell.Value
Workbooks("Numbers for Item Add_Change Tracking Spreadsheet v111512C.xlsx").Save
Workbooks("Numbers for Item Add_Change Tracking Spreadsheet v111512C.xlsx").Close

Workbooks.Open ("C:\Test Directory Structure\Add-In Forms\UPLOAD SPREADSHEET.xlsx")

Windows("" & IM & ".xlsx").Activate
Sheets("REQUESTER").Select

Dim aa, ab, ac, ad, ae, af, ag, ah, i As Long, y, ba&, bb&, bc&, bd&, be&, bf&, bg&, bh&

  With Worksheets("REQUESTER")
    y = .Range("F9:DN" & .Cells.Find("*", , , , xlByRows, xlPrevious).Row)
 End With

  ReDim aa(1 To UBound(y), 1 To UBound(y, 2))
  ReDim ab(1 To UBound(y), 1 To UBound(y, 2))
  ReDim ac(1 To UBound(y), 1 To UBound(y, 2))
  ReDim ad(1 To UBound(y), 1 To UBound(y, 2))
  ReDim ae(1 To UBound(y), 1 To UBound(y, 2))
  ReDim af(1 To UBound(y), 1 To UBound(y, 2))
  ReDim ag(1 To UBound(y), 1 To UBound(y, 2))
  ReDim ah(1 To UBound(y), 1 To UBound(y, 2))
  
    
    
     For i = 1 To UBound(y, 1)
        If y(i, 1) = "x" Then
                ba = ba + 1
                aa(ba, 2) = y(i, 63)
                aa(ba, 3) = y(i, 64)
                aa(ba, 4) = y(i, 82)
                aa(ba, 5) = y(i, 83)
                aa(ba, 6) = y(i, 70)
                aa(ba, 7) = y(i, 71)
                aa(ba, 8) = y(i, 72)
                aa(ba, 10) = y(i, 84)
                aa(ba, 11) = y(i, 85)
                aa(ba, 12) = y(i, 73)
                aa(ba, 13) = y(i, 74)
                aa(ba, 14) = y(i, 94)
                aa(ba, 15) = y(i, 95)
                aa(ba, 16) = y(i, 96)
                aa(ba, 17) = y(i, 97)
                aa(ba, 18) = y(i, 75)
                aa(ba, 19) = y(i, 76)
                aa(ba, 20) = y(i, 77)
                aa(ba, 21) = y(i, 98)
                aa(ba, 22) = y(i, 99)
                aa(ba, 23) = y(i, 100)
                aa(ba, 24) = y(i, 101)
                aa(ba, 25) = y(i, 78)
                aa(ba, 26) = y(i, 79)
                aa(ba, 27) = y(i, 80)
                aa(ba, 28) = y(i, 102)
                aa(ba, 29) = y(i, 103)
                aa(ba, 30) = y(i, 104)
                aa(ba, 31) = y(i, 105)
                aa(ba, 32) = y(i, 81)
                aa(ba, 33) = y(i, 88)
                aa(ba, 34) = y(i, 65)
                aa(ba, 35) = y(i, 86)
                aa(ba, 36) = y(i, 87)
                 If y(i, 2) = "x" Then
                   bb = bb + 1
                    ab(bb, 2) = y(i, 63)
                    ab(bb, 3) = y(i, 64)
                    ab(bb, 4) = y(i, 82)
                    ab(bb, 5) = y(i, 70)
                    ab(bb, 6) = y(i, 71)
                    ab(bb, 7) = y(i, 72)
                    ab(bb, 8) = y(i, 65)
                 End If
          End If
                If y(i, 3) = "x" Then
                     bc = bc + 1
                      ac(bc, 2) = y(i, 63)
                      ac(bc, 4) = y(i, 67)
                      ac(bc, 5) = y(i, 68)
                      ac(bc, 6) = y(i, 70)
                      ac(bc, 7) = y(i, 71)
                      ac(bc, 8) = y(i, 72)
                End If
                     If y(i, 4) = "x" Then
                        bd = bd + 1
                        ad(bd, 2) = y(i, 113)
                        ad(bd, 4) = y(i, 68)
                        ad(bd, 5) = y(i, 63)
                        ad(bd, 6) = y(i, 110)
                        ad(bd, 7) = y(i, 108)
                        ad(bd, 8) = y(i, 88)
                     End If
                           If y(i, 5) = "x" Then
                              be = be + 1
                             ae(be, 2) = y(i, 58)
                             ae(be, 3) = y(i, 59)
                             ae(be, 4) = y(i, 15)
                           End If
                         If y(i, 11) = "x" Then
                            bf = bf + 1
                            af(bf, 2) = y(i, 113)
                            af(bf, 4) = y(i, 107)
                            af(bf, 5) = y(i, 68)
                            af(bf, 6) = y(i, 63)
                            af(bf, 7) = y(i, 110)
                            af(bf, 8) = y(i, 108)
                        End If
                                If y(i, 11) = "x" Then
                                   bg = bg + 1
                                   ag(bg, 2) = y(i, 63)
                                   ag(bg, 4) = y(i, 67)
                                   ag(bg, 5) = y(i, 68)
                                   ag(bg, 6) = y(i, 64)
                                End If
                                     If y(i, 11) = "x" Then
                                        bh = bh + 1
                                        ah(bh, 2) = y(i, 63)
                                        ah(bh, 3) = y(i, 64)
                                        ah(bh, 4) = y(i, 65)
                                     End If
        
                 
     Next
  Windows("UPLOAD SPREADSHEET.xlsx").Activate
  With Worksheets("IC11 ADD")
    .UsedRange.Offset(5).ClearContents
    If ba > 0 Then .Range("A6").Resize(ba, UBound(y, 2)).Value = aa
 End With
  
   With Worksheets("IC11 CHANGE")
     .UsedRange.Offset(5).ClearContents
     If bb > 0 Then .Range("A6").Resize(bb, UBound(y, 2)).Value = ab
   End With

   With Worksheets("PO13")
     .UsedRange.Offset(5).ClearContents
     If bc > 0 Then .Range("A6").Resize(bc, UBound(y, 2)).Value = ac
   End With

   With Worksheets("PO25.6 NEW AGREEMENT")
     .UsedRange.Offset(5).ClearContents
     If bd > 0 Then .Range("A6").Resize(bd, UBound(y, 2)).Value = ad
   End With

   With Worksheets("PO25.6 HOLD")
     .UsedRange.Offset(5).ClearContents
     If be > 0 Then .Range("A6").Resize(be, UBound(y, 2)).Value = ae
   End With

   With Worksheets("PRICE ONLY")
     .UsedRange.Offset(5).ClearContents
     If bf > 0 Then .Range("A6").Resize(bf, UBound(y, 2)).Value = af
   End With
   
   With Worksheets("P013 INACT")
     .UsedRange.Offset(5).ClearContents
     If bg > 0 Then .Range("A6").Resize(bg, UBound(y, 2)).Value = ag
   End With
   
   With Worksheets("IC11 INACT")
     .UsedRange.Offset(5).ClearContents
     If bh > 0 Then .Range("A6").Resize(bh, UBound(y, 2)).Value = ah
   End With
   
If Sheets("IC11 CHANGE").Range("$B$6").Value > 0 Then Sheets("IC11 CHANGE").Tab.ColorIndex = 6

If Sheets("PO13").Range("$B$6").Value > 0 Then Sheets("PO13").Tab.ColorIndex = 6

If Sheets("PO25.6 NEW AGREEMENT").Range("$B$6").Value > 0 Then Sheets("PO25.6 NEW AGREEMENT").Tab.ColorIndex = 6

If Sheets("PO25.6 HOLD").Range("$B$6").Value > 0 Then Sheets("PO25.6 HOLD").Tab.ColorIndex = 6

If Sheets("PRICE ONLY").Range("$B$6").Value > 0 Then Sheets("PRICE ONLY").Tab.ColorIndex = 6

If Sheets("IC11 ADD").Range("$B$6").Value > 0 Then Sheets("IC11 ADD").Tab.ColorIndex = 6

If Sheets("P013 INACT").Range("$B$6").Value > 0 Then Sheets("P013 INACT").Tab.ColorIndex = 6

If Sheets("IC11 INACT").Range("$B$6").Value > 0 Then Sheets("IC11 INACT").Tab.ColorIndex = 6
   

End Sub

**romperstomper** · 09-29-2014, 09:23 AM

Are you sure the cells contain "x" and not "X"? Your tests are case sensitive.

**Metrazal** · 09-29-2014, 03:48 PM

Thanks ofr everyones help and guidance.

AB33: I followed your suggestions and it did help cleanup the script somewhat.

romperstomper: The "case" was not the issue but your suggestion made me look back at the data to be copied and I discovered that the script was copying the data but the data was blank. (Doh!)

Thanks again,

Met

Frankenstein's script

LinkBack

Thread Tools

Rate This Thread

Display

Hybrid View

Frankenstein's script

Re: Frankenstein's script

Re: Frankenstein's script

Re: Frankenstein's script

Thread Information

Users Browsing this Thread

Similar Threads

script to run the macro from Vb script with out opening the excel file

calling the vb script from the shell script(unix platform)

Integrating Mainframe emulator script with excel's vba script

Create VBA script to short, dedicated button in excel for script?

Script that edits the text printed on the button that runs the script

Bookmarks

Bookmarks

Posting Permissions