+ Reply to Thread
Results 1 to 3 of 3

Help when running code formulas on cells and in names define are changing

Hybrid View

bazofio Help when running code... 12-22-2014, 01:56 PM
bazofio Re: Help when running code... 12-22-2014, 04:49 PM
bazofio Re: Help when running code... 12-22-2014, 07:00 PM
  1. #1
    Forum Contributor
    Join Date
    08-24-2012
    Location
    Portugal
    MS-Off Ver
    Excel 2003
    Posts
    119

    Help when running code formulas on cells and in names define are changing

    Hi guys

    I have a code (thanks to the fantastic members here), and i dont know if its a problema with it or normal excel behaviour.
    This is one part of the code in the sheet:

    Private Sub Worksheet_Change(ByVal Target As Range)
      Dim FiltCrit As String, myComboVal As String
      Dim Rng As Range, Rng1 As Range, myCells As Range
      Dim LR As Long, cNo As Long, x As Long
      If Target.Cells.Count > 1 Or IsEmpty(Target) Then GoTo ExitSub
      If Target.Address = "$L$4" Then
      Application.EnableEvents = False
        With ActiveSheet
        .UsedRange.Offset(0, 68).ClearContents
          LR = .Cells.Find("*", .Cells(.Rows.Count, .Columns.Count), SearchOrder:=xlByRows, _
              SearchDirection:=xlPrevious).Row
          If Not .AutoFilterMode Then
            .Range("AA3:BI3").AutoFilter
          End If
          .Range(.Range("X4"), .Range("Y4").End(xlDown)).ClearContents
          FiltCrit = .Range("L4").Value
          With ActiveSheet.Shapes("Drop Down 3").ControlFormat
            myComboVal = .List(.Value)
          End With
    
          Select Case myComboVal
          Case "ZT/Feeder A1"
            cNo = 2
            .Range("AA3:BI3").AutoFilter Field:=cNo, Criteria1:=FiltCrit
    
            Set Rng = .AutoFilter.Range
            x = Rng.Columns(2).SpecialCells(xlCellTypeVisible).Count - 1
            If x >= 1 Then
              Set Rng = .Range(.Cells(4, 29), .Cells(LR, 29)).SpecialCells(xlCellTypeVisible)
              Set Rng1 = .Range(.Cells(4, 27), .Cells(LR, 27)).SpecialCells(xlCellTypeVisible)
              Set myCells = Union(Rng, Rng1)
            Else
              MsgBox "A Referência " & FiltCrit & " não existe em " & myComboVal
              .ShowAllData
              GoTo ExitSub
            End If
            
            myCells.Copy .Range("X4")
            
    
          Case "Arca A1"
            cNo = 2
            .Range("AA3:BI3").AutoFilter Field:=cNo, Criteria1:=FiltCrit
    
            Set Rng = .AutoFilter.Range
            x = Rng.Columns(2).SpecialCells(xlCellTypeVisible).Count - 1
            If x >= 1 Then
              Set Rng = .Range(.Cells(4, 30), .Cells(LR, 30)).SpecialCells(xlCellTypeVisible)
              Set Rng1 = .Range(.Cells(4, 27), .Cells(LR, 27)).SpecialCells(xlCellTypeVisible)
              Set myCells = Union(Rng, Rng1)
            Else
              MsgBox "A Referência  " & FiltCrit & " não existe em " & myComboVal
              .ShowAllData
              GoTo ExitSub
              
            End If
            
            myCells.Copy .Range("X4")
            
    
          Case "Feeder B1"
            cNo = 10
            .Range("AA3:BI3").AutoFilter Field:=cNo, Criteria1:=FiltCrit
    
            Set Rng = .AutoFilter.Range
            x = Rng.Columns(2).SpecialCells(xlCellTypeVisible).Count - 1
            If x >= 1 Then
              Set Rng = .Range(.Cells(4, 37), .Cells(LR, 37)).SpecialCells(xlCellTypeVisible)
              Set Rng1 = .Range(.Cells(4, 27), .Cells(LR, 27)).SpecialCells(xlCellTypeVisible)
              Set myCells = Union(Rng, Rng1)
            Else
              MsgBox "A Referência " & FiltCrit & " não existe em " & myComboVal
              .ShowAllData
              GoTo ExitSub
            End If
            
            myCells.Copy .Range("X4")
            
    
          Case "Arca B1"
            cNo = 10
            .Range("AA3:BI3").AutoFilter Field:=cNo, Criteria1:=FiltCrit
    
            Set Rng = .AutoFilter.Range
            x = Rng.Columns(2).SpecialCells(xlCellTypeVisible).Count - 1
            If x >= 1 Then
              Set Rng = .Range(.Cells(4, 38), .Cells(LR, 38)).SpecialCells(xlCellTypeVisible)
              Set Rng1 = .Range(.Cells(4, 27), .Cells(LR, 27)).SpecialCells(xlCellTypeVisible)
              Set myCells = Union(Rng, Rng1)
            Else
              MsgBox "A Referência " & FiltCrit & " não existe em " & myComboVal
              .ShowAllData
              GoTo ExitSub
            End If
            
            myCells.Copy .Range("X4")
            
            
          Case "Feeder B2"
            cNo = 13
            .Range("AA3:BI3").AutoFilter Field:=cNo, Criteria1:=FiltCrit
    
            Set Rng = .AutoFilter.Range
            x = Rng.Columns(2).SpecialCells(xlCellTypeVisible).Count - 1
            If x >= 1 Then
              Set Rng = .Range(.Cells(4, 40), .Cells(LR, 40)).SpecialCells(xlCellTypeVisible)
              Set Rng1 = .Range(.Cells(4, 27), .Cells(LR, 27)).SpecialCells(xlCellTypeVisible)
              Set myCells = Union(Rng, Rng1)
            Else
              MsgBox "A Referência " & FiltCrit & " não existe em " & myComboVal
              .ShowAllData
              GoTo ExitSub
            End If
            
            myCells.Copy .Range("X4")
            
            
          Case "Arca B2"
            cNo = 13
            .Range("AA3:BI3").AutoFilter Field:=cNo, Criteria1:=FiltCrit
    
            Set Rng = .AutoFilter.Range
            x = Rng.Columns(2).SpecialCells(xlCellTypeVisible).Count - 1
            If x >= 1 Then
              Set Rng = .Range(.Cells(4, 41), .Cells(LR, 41)).SpecialCells(xlCellTypeVisible)
              Set Rng1 = .Range(.Cells(4, 27), .Cells(LR, 27)).SpecialCells(xlCellTypeVisible)
              Set myCells = Union(Rng, Rng1)
            Else
              MsgBox "A Referência " & FiltCrit & " não existe em " & myComboVal
              .ShowAllData
              GoTo ExitSub
            End If
            
            myCells.Copy .Range("X4")
            
            
          Case "Feeder B3"
            cNo = 16
            .Range("AA3:BI3").AutoFilter Field:=cNo, Criteria1:=FiltCrit
    
            Set Rng = .AutoFilter.Range
            x = Rng.Columns(2).SpecialCells(xlCellTypeVisible).Count - 1
            If x >= 1 Then
              Set Rng = .Range(.Cells(4, 43), .Cells(LR, 43)).SpecialCells(xlCellTypeVisible)
              Set Rng1 = .Range(.Cells(4, 27), .Cells(LR, 27)).SpecialCells(xlCellTypeVisible)
              Set myCells = Union(Rng, Rng1)
            Else
              MsgBox "A Referência " & FiltCrit & " não existe em " & myComboVal
              .ShowAllData
              GoTo ExitSub
            End If
            
            myCells.Copy .Range("X4")
            
            
          Case "Arca B3"
            cNo = 13
            .Range("AA3:BI3").AutoFilter Field:=cNo, Criteria1:=FiltCrit
    
            Set Rng = .AutoFilter.Range
            x = Rng.Columns(2).SpecialCells(xlCellTypeVisible).Count - 1
            If x >= 1 Then
              Set Rng = .Range(.Cells(4, 44), .Cells(LR, 44)).SpecialCells(xlCellTypeVisible)
              Set Rng1 = .Range(.Cells(4, 27), .Cells(LR, 27)).SpecialCells(xlCellTypeVisible)
              Set myCells = Union(Rng, Rng1)
            Else
              MsgBox "A Referência " & FiltCrit & " não existe em " & myComboVal
              .ShowAllData
              GoTo ExitSub
            End If
            
            myCells.Copy .Range("X4")
            
            
          Case "Feeder B4"
            cNo = 19
            .Range("AA3:BI3").AutoFilter Field:=cNo, Criteria1:=FiltCrit
    
            Set Rng = .AutoFilter.Range
            x = Rng.Columns(2).SpecialCells(xlCellTypeVisible).Count - 1
            If x >= 1 Then
              Set Rng = .Range(.Cells(4, 46), .Cells(LR, 46)).SpecialCells(xlCellTypeVisible)
              Set Rng1 = .Range(.Cells(4, 27), .Cells(LR, 27)).SpecialCells(xlCellTypeVisible)
              Set myCells = Union(Rng, Rng1)
            Else
              MsgBox "A Referência " & FiltCrit & " não existe em " & myComboVal
              .ShowAllData
              GoTo ExitSub
            End If
            
            myCells.Copy .Range("X4")
            
            
          Case "Arca B4"
            cNo = 19
            .Range("AA3:BI3").AutoFilter Field:=cNo, Criteria1:=FiltCrit
    
            Set Rng = .AutoFilter.Range
            x = Rng.Columns(2).SpecialCells(xlCellTypeVisible).Count - 1
            If x >= 1 Then
              Set Rng = .Range(.Cells(4, 47), .Cells(LR, 47)).SpecialCells(xlCellTypeVisible)
              Set Rng1 = .Range(.Cells(4, 27), .Cells(LR, 27)).SpecialCells(xlCellTypeVisible)
              Set myCells = Union(Rng, Rng1)
            Else
              MsgBox "A Referência " & FiltCrit & " não existe em " & myComboVal
              .ShowAllData
              GoTo ExitSub
            End If
            
            myCells.Copy .Range("X4")
            
            
          Case "Feeder C1"
            cNo = 27
            .Range("AA3:BI3").AutoFilter Field:=cNo, Criteria1:=FiltCrit
    
            Set Rng = .AutoFilter.Range
            x = Rng.Columns(2).SpecialCells(xlCellTypeVisible).Count - 1
            If x >= 1 Then
              Set Rng = .Range(.Cells(4, 54), .Cells(LR, 54)).SpecialCells(xlCellTypeVisible)
              Set Rng1 = .Range(.Cells(4, 27), .Cells(LR, 27)).SpecialCells(xlCellTypeVisible)
              Set myCells = Union(Rng, Rng1)
            Else
              MsgBox "A Referência " & FiltCrit & " não existe em " & myComboVal
              .ShowAllData
              GoTo ExitSub
            End If
            
            myCells.Copy .Range("X4")
            
            
          Case "Arca C1"
            cNo = 27
            .Range("AA3:BI3").AutoFilter Field:=cNo, Criteria1:=FiltCrit
    
            Set Rng = .AutoFilter.Range
            x = Rng.Columns(2).SpecialCells(xlCellTypeVisible).Count - 1
            If x >= 1 Then
              Set Rng = .Range(.Cells(4, 55), .Cells(LR, 55)).SpecialCells(xlCellTypeVisible)
              Set Rng1 = .Range(.Cells(4, 27), .Cells(LR, 27)).SpecialCells(xlCellTypeVisible)
              Set myCells = Union(Rng, Rng1)
            Else
              MsgBox "A Referência " & FiltCrit & " não existe em " & myComboVal
              .ShowAllData
              GoTo ExitSub
            End If
            
            myCells.Copy .Range("X4")
            
            
          Case "Feeder C2"
            cNo = 30
            .Range("AA3:BI3").AutoFilter Field:=cNo, Criteria1:=FiltCrit
    
            Set Rng = .AutoFilter.Range
            x = Rng.Columns(2).SpecialCells(xlCellTypeVisible).Count - 1
            If x >= 1 Then
              Set Rng = .Range(.Cells(4, 57), .Cells(LR, 57)).SpecialCells(xlCellTypeVisible)
              Set Rng1 = .Range(.Cells(4, 27), .Cells(LR, 27)).SpecialCells(xlCellTypeVisible)
              Set myCells = Union(Rng, Rng1)
            Else
              MsgBox "A Referência " & FiltCrit & " não existe em " & myComboVal
              .ShowAllData
              GoTo ExitSub
            End If
            
            myCells.Copy .Range("X4")
            
            
          Case "Arca C2"
            cNo = 30
            .Range("AA3:BI3").AutoFilter Field:=cNo, Criteria1:=FiltCrit
    
            Set Rng = .AutoFilter.Range
            x = Rng.Columns(2).SpecialCells(xlCellTypeVisible).Count - 1
            If x >= 1 Then
              Set Rng = .Range(.Cells(4, 58), .Cells(LR, 58)).SpecialCells(xlCellTypeVisible)
              Set Rng1 = .Range(.Cells(4, 27), .Cells(LR, 27)).SpecialCells(xlCellTypeVisible)
              Set myCells = Union(Rng, Rng1)
            Else
              MsgBox "A Referência " & FiltCrit & " não existe em " & myComboVal
              .ShowAllData
              GoTo ExitSub
            End If
            
            myCells.Copy .Range("X4")
            
            
          Case "Feeder C3"
            cNo = 33
            .Range("AA3:BI3").AutoFilter Field:=cNo, Criteria1:=FiltCrit
    
            Set Rng = .AutoFilter.Range
            x = Rng.Columns(2).SpecialCells(xlCellTypeVisible).Count - 1
            If x >= 1 Then
              Set Rng = .Range(.Cells(4, 60), .Cells(LR, 60)).SpecialCells(xlCellTypeVisible)
              Set Rng1 = .Range(.Cells(4, 27), .Cells(LR, 27)).SpecialCells(xlCellTypeVisible)
              Set myCells = Union(Rng, Rng1)
            Else
              MsgBox "A Referência " & FiltCrit & " não existe em " & myComboVal
              .ShowAllData
              GoTo ExitSub
            End If
            
            myCells.Copy .Range("X4")
            
            
          Case "Arca C3"
            cNo = 33
            .Range("AA3:BI3").AutoFilter Field:=cNo, Criteria1:=FiltCrit
    
            Set Rng = .AutoFilter.Range
            x = Rng.Columns(2).SpecialCells(xlCellTypeVisible).Count - 1
            If x >= 1 Then
              Set Rng = .Range(.Cells(4, 61), .Cells(LR, 61)).SpecialCells(xlCellTypeVisible)
              Set Rng1 = .Range(.Cells(4, 27), .Cells(LR, 27)).SpecialCells(xlCellTypeVisible)
              Set myCells = Union(Rng, Rng1)
            Else
              MsgBox "A Referência " & FiltCrit & " não existe em " & myComboVal
              .ShowAllData
              GoTo ExitSub
            End If
            
            myCells.Copy .Range("X4")
            
            
            
          End Select
          .ShowAllData
        End With
      End If
    ExitSub:    Application.EnableEvents = True: Application.CutCopyMode = False
    ActiveSheet.Shapes("Drop Down 3").Select: Selection.Height = 24
    Range("L4").Activate
    End Sub
    The other part is this one on module:
    Option Explicit
    
    Sub teste()
    Dim lastrow&, firstrow&, currentdate As Date
    Application.ScreenUpdating = False
    lastrow = Cells(Rows.Count, "X").End(xlUp).Row
    firstrow = lastrow
    currentdate = Cells(lastrow, "X")
    While firstrow > 1
      If currentdate - Cells(firstrow, "X") <= 1 Then
        currentdate = Cells(firstrow, "X")
        firstrow = firstrow - 1
      Else
        Columns("BQ:BR").Insert shift:=xlToRight
        Range(Cells(firstrow + 1, "X"), Cells(lastrow, "Y")).Cut Range("BQ2")
        lastrow = firstrow
        currentdate = Cells(firstrow, "X")
      End If
    Wend
    End Sub
    Everything is working ok until when i press the button to run the second code that divide all data in periods of time. When i run it, some formulas that i have in cells related to the range (that is beeing populated by this second code) changes the location automatic just like some names with a offset formula to those ranges are changing too.

    Is there a way to avoid this but keeping the code running like it is? (just correcting this annoying problem)

    Thanks in advance

  2. #2
    Forum Contributor
    Join Date
    08-24-2012
    Location
    Portugal
    MS-Off Ver
    Excel 2003
    Posts
    119

    Re: Help when running code formulas on cells and in names define are changing

    So i think that i find the problema.
    The second code is shifting the data to the right and every time it does that all my formulas are shifting too, just like the offsets that i have in the Names (define names).
    Is there anything that could be done in the code to avoid the changes in the formulas and names?

    Thanks in advance.

  3. #3
    Forum Contributor
    Join Date
    08-24-2012
    Location
    Portugal
    MS-Off Ver
    Excel 2003
    Posts
    119

    Re: Help when running code formulas on cells and in names define are changing

    Anyone please

+ Reply to Thread

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Similar Threads

  1. [SOLVED] Define New Names for Specific Cells
    By boss1982 in forum Excel Programming / VBA / Macros
    Replies: 14
    Last Post: 04-01-2013, 09:42 AM
  2. Changing source workbook names directly in formulas
    By sine.grujica in forum Excel Programming / VBA / Macros
    Replies: 0
    Last Post: 01-16-2013, 08:49 AM
  3. Replies: 5
    Last Post: 11-03-2012, 05:10 PM
  4. Changing this code so that it names the new sheet on creation rather than after
    By UsmanBPD in forum Excel Programming / VBA / Macros
    Replies: 3
    Last Post: 07-06-2012, 10:40 AM
  5. Replies: 4
    Last Post: 04-25-2006, 06:15 PM

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1