+ Reply to Thread
Results 1 to 3 of 3

Improve Code

Hybrid View

  1. 09-13-2023, 06:41 AM #1
    jynxy
    jynxy is offline
    Registered User
    Join Date
    01-23-2022
    Location
    uk
    MS-Off Ver
    MS Office 365
    Posts
    27

    Improve Code

    Hi,

    Thanks for looking, i have created this macro which works but a bit clunky, im sure it could be made better.

    What we have is a export dump that gets updated regularly, we cannot change how this is. This provides data from yesterday for the next 20 days, unfortunately we need to keep the data for the week, but be able to update. i have set a macro to copy this data in (not show), then split into days, if the data has passed 24 hours then keep the current data, but update the rest of the days. So on Sat it would update Sat to Fri, Sun would still update Sat to Fri as the data is still there, however on Mon it would ignore Sat leaving the data there but update Sun to Fri and so forth till the end of the week. Which we will then start again with a new sheet for the week.

    As i have said this works fine just clunky, perfdatex = each date for the week, this could actually be changed to start date + 1 etc, note that perfdate2 is the startdate and continue in order from here, the only exception is perfdate1 which is the day before.

    Any help would be much apreciated.

    PerfDate1 = ThisWorkbook.Sheets("Colleague Database").Range("N1").Value
PerfDate1 = Format(PerfDate1, "MM/DD/YYYY")

PerfDate2 = ThisWorkbook.Sheets("Colleague Database").Range("O1").Value
PerfDate2 = Format(PerfDate2, "MM/DD/YYYY")

PerfDate3 = ThisWorkbook.Sheets("Colleague Database").Range("R1").Value
PerfDate3 = Format(PerfDate3, "MM/DD/YYYY")

PerfDate4 = ThisWorkbook.Sheets("Colleague Database").Range("U1").Value
PerfDate4 = Format(PerfDate4, "MM/DD/YYYY")

PerfDate5 = ThisWorkbook.Sheets("Colleague Database").Range("X1").Value
PerfDate5 = Format(PerfDate5, "MM/DD/YYYY")

PerfDate6 = ThisWorkbook.Sheets("Colleague Database").Range("AA1").Value
PerfDate6 = Format(PerfDate6, "MM/DD/YYYY")

PerfDate7 = ThisWorkbook.Sheets("Colleague Database").Range("AD1").Value
PerfDate7 = Format(PerfDate7, "MM/DD/YYYY")

PerfDate8 = ThisWorkbook.Sheets("Colleague Database").Range("AG1").Value
PerfDate8 = Format(PerfDate8, "MM/DD/YYYY")

PerfDate9 = ThisWorkbook.Sheets("Colleague Database").Range("L1").Value
PerfDate9 = Format(PerfDate9, "MM/DD/YYYY")

Now2 = CDate(Now() - 1) 'formatting the date using the CDate function
Now2 = Format(Now2, "MM/DD/YYYY") 'formatting the date by dropping the hour

Worksheets("Data").Visible = True
Worksheets("Day1").Visible = True
Worksheets("Day2").Visible = True
Worksheets("Day3").Visible = True
Worksheets("Day4").Visible = True
Worksheets("Day5").Visible = True
Worksheets("Day6").Visible = True
Worksheets("Day7").Visible = True
Worksheets("Day8").Visible = True
Worksheets("Day9").Visible = True
Worksheets("DaysMerged").Visible = True

' Day 1 (Friday)
If PerfDate1 >= Now2 Then
    Workbooks(MyFile).Sheets("Day1").Range("a:h").ClearContents
    Sheets("Data").Select
    If ActiveSheet.AutoFilterMode Then
         ActiveSheet.AutoFilterMode = False
      End If
    Range("A1").Select
    ActiveSheet.Range("$A$1:$G$12000").AutoFilter Field:=5, Operator:= _
            xlFilterValues, Criteria2:=Array(2, PerfDate1)
    Range("A1:G1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy Workbooks(MyFile).Sheets("Day1").Range("a1")
End If

' Day 2 (Saturday)
If PerfDate2 >= Now2 Then
    Workbooks(MyFile).Sheets("Day2").Range("a:h").ClearContents
    Sheets("Data").Select
    If ActiveSheet.AutoFilterMode Then
         ActiveSheet.AutoFilterMode = False
      End If
    Range("A1").Select
    ActiveSheet.Range("$A$1:$G$12000").AutoFilter Field:=5, Operator:= _
            xlFilterValues, Criteria2:=Array(2, PerfDate2)
    Range("A1:G1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy Workbooks(MyFile).Sheets("Day2").Range("a1")
End If

' Day 3 (Sunday)
If PerfDate3 >= Now2 Then
    Workbooks(MyFile).Sheets("Day3").Range("a:h").ClearContents
    Sheets("Data").Select
    If ActiveSheet.AutoFilterMode Then
         ActiveSheet.AutoFilterMode = False
      End If
    Range("A1").Select
    ActiveSheet.Range("$A$1:$G$12000").AutoFilter Field:=5, Operator:= _
            xlFilterValues, Criteria2:=Array(2, PerfDate3)
    Range("A1:G1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy Workbooks(MyFile).Sheets("Day3").Range("a1")
End If

' Day 4 (Monday)
If PerfDate4 >= Now2 Then
    Workbooks(MyFile).Sheets("Day4").Range("a:h").ClearContents
    Workbooks(MyFile).Sheets("Data").Select
    If ActiveSheet.AutoFilterMode Then
         ActiveSheet.AutoFilterMode = False
      End If
    Range("A1").Select
    ActiveSheet.Range("$A$1:$G$12000").AutoFilter Field:=5, Operator:= _
            xlFilterValues, Criteria2:=Array(2, PerfDate4)
    'Range(Selection, Selection.End(xlToRight)).Select
    Range("A1:G1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy Workbooks(MyFile).Sheets("Day4").Range("a1")
End If

' Day 5 (Tuesday)
If PerfDate5 >= Now2 Then
    Workbooks(MyFile).Sheets("Day5").Range("a:h").ClearContents
    Sheets("Data").Select
    If ActiveSheet.AutoFilterMode Then
         ActiveSheet.AutoFilterMode = False
      End If
    Range("A1").Select
    ActiveSheet.Range("$A$1:$G$12000").AutoFilter Field:=5, Operator:= _
            xlFilterValues, Criteria2:=Array(2, PerfDate5)
    Range("A1:G1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy Workbooks(MyFile).Sheets("Day5").Range("a1")
End If

' Day 6 (Wednesday)
If PerfDate6 >= Now2 Then
    Workbooks(MyFile).Sheets("Day6").Range("a:h").ClearContents
    Sheets("Data").Select
    If ActiveSheet.AutoFilterMode Then
         ActiveSheet.AutoFilterMode = False
      End If
    Range("A1").Select
    ActiveSheet.Range("$A$1:$G$12000").AutoFilter Field:=5, Operator:= _
            xlFilterValues, Criteria2:=Array(2, PerfDate6)
    Range("A1:G1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy Workbooks(MyFile).Sheets("Day6").Range("a1")
End If

' Day 7 (Thursday)
If PerfDate7 >= Now2 Then
    Workbooks(MyFile).Sheets("Day7").Range("a:h").ClearContents
    Sheets("Data").Select
    If ActiveSheet.AutoFilterMode Then
         ActiveSheet.AutoFilterMode = False
      End If
    Range("A1").Select
    ActiveSheet.Range("$A$1:$G$12000").AutoFilter Field:=5, Operator:= _
            xlFilterValues, Criteria2:=Array(2, PerfDate7)
    Range("A1:G1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy Workbooks(MyFile).Sheets("Day7").Range("a1")
End If

' Day 8 (Friday)
If PerfDate8 >= Now2 Then
    Workbooks(MyFile).Sheets("Day8").Range("a:h").ClearContents
    Sheets("Data").Select
    If ActiveSheet.AutoFilterMode Then
         ActiveSheet.AutoFilterMode = False
      End If
    Range("A1").Select
    ActiveSheet.Range("$A$1:$G$12000").AutoFilter Field:=5, Operator:= _
            xlFilterValues, Criteria2:=Array(2, PerfDate8)
    Range("A1:G1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy Workbooks(MyFile).Sheets("Day8").Range("a1")
End If

' Day 9 (Saturday)
If PerfDate9 >= Now2 Then
    Workbooks(MyFile).Sheets("Day9").Range("a:h").ClearContents
    Sheets("Data").Select
    If ActiveSheet.AutoFilterMode Then
         ActiveSheet.AutoFilterMode = False
      End If
    Range("A1").Select
    ActiveSheet.Range("$A$1:$G$12000").AutoFilter Field:=5, Operator:= _
            xlFilterValues, Criteria2:=Array(2, PerfDate9)
    Range("A1:G1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy Workbooks(MyFile).Sheets("Day9").Range("a1")
End If


''' Merge Days ''''

Workbooks(MyFile).Sheets("DaysMerged").Range("a:h").ClearContents

' Day 1
Sheets("Day1").Select
Range("A1:G1").Select
Range(Selection, Selection.End(xlDown)).Select
Last_Row = Range("A" & Rows.Count).End(xlUp).Row
If Last_Row > 1 Then
    Selection.Copy
    Sheets("DaysMerged").Select
    Range("A1").Select

    Last_Row = Range("A" & Rows.Count).End(xlUp).Row

    With Range("A1")
        .PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        .PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    End With
End If

' Day 2
Sheets("Day2").Select
Range("A2:G2").Select
Range(Selection, Selection.End(xlDown)).Select
Last_Row = Range("A" & Rows.Count).End(xlUp).Row
If Last_Row > 1 Then
    Selection.Copy
    Sheets("DaysMerged").Select
    Range("A1").Select

    Last_Row = Range("A" & Rows.Count).End(xlUp).Row

    With Range("A" & Last_Row + 1)
        .PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        .PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    End With
End If

' Day 3
Sheets("Day3").Select
Range("A2:G2").Select
Range(Selection, Selection.End(xlDown)).Select
Last_Row = Range("A" & Rows.Count).End(xlUp).Row
If Last_Row > 1 Then
    Selection.Copy
    Sheets("DaysMerged").Select
    Range("A1").Select

    Last_Row = Range("A" & Rows.Count).End(xlUp).Row

    With Range("A" & Last_Row + 1)
       .PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
          :=False, Transpose:=False
       .PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
          SkipBlanks:=False, Transpose:=False
    End With
End If

' Day 4
Sheets("Day4").Select
Range("A2:G2").Select
Range(Selection, Selection.End(xlDown)).Select
Last_Row = Range("A" & Rows.Count).End(xlUp).Row
If Last_Row > 1 Then
    Selection.Copy
    Sheets("DaysMerged").Select
    Range("A1").Select
    
    Last_Row = Range("A" & Rows.Count).End(xlUp).Row
    
    With Range("A" & Last_Row + 1)
       .PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
          :=False, Transpose:=False
       .PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
          SkipBlanks:=False, Transpose:=False
    End With
End If

' Day 5
Sheets("Day5").Select
Range("A2:G2").Select
Range(Selection, Selection.End(xlDown)).Select
Last_Row = Range("A" & Rows.Count).End(xlUp).Row
If Last_Row > 1 Then
    Selection.Copy
    Sheets("DaysMerged").Select
    Range("A1").Select
    
    Last_Row = Range("A" & Rows.Count).End(xlUp).Row
    
    With Range("A" & Last_Row + 1)
       .PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
          :=False, Transpose:=False
       .PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
          SkipBlanks:=False, Transpose:=False
    End With
End If

' Day 6
Sheets("Day6").Select
Range("A2:G2").Select
Range(Selection, Selection.End(xlDown)).Select
Last_Row = Range("A" & Rows.Count).End(xlUp).Row
If Last_Row > 1 Then
    Selection.Copy
    Sheets("DaysMerged").Select
    Range("A1").Select
    
    Last_Row = Range("A" & Rows.Count).End(xlUp).Row
    
    With Range("A" & Last_Row + 1)
       .PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
          :=False, Transpose:=False
       .PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
          SkipBlanks:=False, Transpose:=False
    End With
End If

' Day 7
Sheets("Day7").Select
Range("A2:G2").Select
Range(Selection, Selection.End(xlDown)).Select
Last_Row = Range("A" & Rows.Count).End(xlUp).Row
If Last_Row > 1 Then
    Selection.Copy
    Sheets("DaysMerged").Select
    Range("A1").Select
    
    Last_Row = Range("A" & Rows.Count).End(xlUp).Row
    
    With Range("A" & Last_Row + 1)
       .PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
          :=False, Transpose:=False
       .PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
          SkipBlanks:=False, Transpose:=False
    End With
End If

' Day 8
Sheets("Day8").Select
Range("A2:G2").Select
Range(Selection, Selection.End(xlDown)).Select
Last_Row = Range("A" & Rows.Count).End(xlUp).Row
If Last_Row > 1 Then
    Selection.Copy
    Sheets("DaysMerged").Select
    Range("A1").Select
    
    Last_Row = Range("A" & Rows.Count).End(xlUp).Row
    
    With Range("A" & Last_Row + 1)
       .PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
          :=False, Transpose:=False
       .PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
          SkipBlanks:=False, Transpose:=False
    End With
End If

' Day 9
Sheets("Day9").Select
Range("A2:G2").Select
Range(Selection, Selection.End(xlDown)).Select
Last_Row = Range("A" & Rows.Count).End(xlUp).Row
If Last_Row > 1 Then
    Selection.Copy
    Sheets("DaysMerged").Select
    Range("A1").Select
    Last_Row = Range("A" & Rows.Count).End(xlUp).Row
    
    With Range("A" & Last_Row + 1)
       .PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
          :=False, Transpose:=False
       .PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
          SkipBlanks:=False, Transpose:=False
    End With
End If

Worksheets("Data").Visible = False
Worksheets("Day1").Visible = False
Worksheets("Day2").Visible = False
Worksheets("Day3").Visible = False
Worksheets("Day4").Visible = False
Worksheets("Day5").Visible = False
Worksheets("Day6").Visible = False
Worksheets("Day7").Visible = False
Worksheets("Day8").Visible = False
Worksheets("Day9").Visible = False
Worksheets("DaysMerged").Visible = False
    Reply With QuoteRegister To Reply
  2. 09-13-2023, 04:46 PM #2
    Bernie Deitrick
    Bernie Deitrick is offline
    Forum Expert
    Join Date
    02-11-2014
    Location
    New York
    MS-Off Ver
    Excel 365 (Windows)
    Posts
    6,022

    Re: Improve Code

    Honestly, there is no such thing as too clunky of a macro. If it works - and doesn't take all day - then don't worry about it.

    Could it be improved? Probably. Is it worth improving? Probably not.
    Bernie Deitrick
    Excel MVP 2000-2010
    Reply With QuoteRegister To Reply
  3. 09-15-2023, 10:07 AM #3
    6StringJazzer
    6StringJazzer is online now
    Administrator 6StringJazzer's Avatar
    Join Date
    01-27-2010
    Location
    Tysons Corner, VA, USA
    MS-Off Ver
    MS 365 Family 64-bit 2404
    Posts
    24,866

    Re: Improve Code

    There are a number of problems with this code, and opportunities for improvement.

    It appears that you did not show all your code, see blue text below.

    You do not show any variable declarations. I strongly recommend to everyone that they use Option Explicit and declare variables. Doing so prevents a lot of bugs and runtime errors.

    You assign strings to the PerfDaten and Now2 variables, but want to use them as dates. Just make them dates. And use the built-in function Date to give the current date rather than using Now() and then manipulating it to give just the date.

    It is not necessary to use ThisWorkbook to qualify range references. This is the default.

    Your code for each day is identical except for the day and sheets. This can be factored out, greatly improving maintainability.

    Do not Select sheets or other objects to manipulate them. Just reference them directly. There are exceptions to this but they don't apply to your code.

    You do not need to unhide then hide these sheets to do any of this work, once you eliminate Select and Selection.

    Variable MyFile is undefined, used in Workbooks(MyFile). I have no idea what you are trying to refer to here.

    In the merging part you are doing a PasteValues and then a PasteFormats. This is essentially just a Paste, not sure why you are doing it this way.

    Here is the rewritten code, but I cannot test it without having your file. If you attach a file with sample data I'd be happy to test it.
       Dim PerfDates(1 To 9) As Date
   Dim PerfDate As Variant ' must be variant to use in For loop
   Dim DayNum As Integer
   Dim LastRow As Long
   
   With Worksheets("Colleague Database")
   
      For Each PerfDate In Array(.Range("N1").Value, _
                                 .Range("O1").Value, _
                                 .Range("R1").Value, _
                                 .Range("U1").Value, _
                                 .Range("X1").Value, _
                                 .Range("AA1").Value, _
                                 .Range("AD1").Value, _
                                 .Range("AG1").Value, _
                                 .Range("L1").Value)
         DayNum = DayNum + 1
         PerfDates(DayNum) = PerfDate
        
      Next PerfDate
   
   End With
   
   Worksheets("Data").Visible = xlSheetVisible
   Worksheets("DaysMerged").Visible = xlSheetVisible
   
   Workbooks(MyFile).Sheets("DaysMerged").Range("A:H").ClearContents ' MyFile is undefined
   
   For DayNum = 1 To 9   ' Day 1 = Friday
   
      If PerfDate(DayNum) >= Date Then
      
          Workbooks(MyFile).Sheets("Day" & DayNum).Range("A:H").ClearContents ' MyFile is undefined
          
          With Sheets("Data")
          
             If .AutoFilterMode Then
                  .AutoFilterMode = False
             End If
             .Range("A1").Select
             .Range("$A$1:$G$12000").AutoFilter Field:=5, Operator:= _
                     xlFilterValues, Criteria2:=Array(2, PerfDate(DayNum))
            
             LastRow = .Cells(.Rows.Count, "G").End(xlUp).Row
             .Range("A1:G" & LastRow).Copy Workbooks(MyFile).Sheets("Day" & DayNum).Range("A1")
             
          End With
          
      End If
      
      
      ''' Merge Days ''''
      With Sheets("Day" & DayNum)
      
         LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
         
         If LastRow > 1 Then
             .Range("A1:G" & LastRow).Copy Sheets("DaysMerged").Range("A1")
         End If
      
      End With
      
   
   Next DayNum
    Jeff
    | | |會 |會 |會 |會 | |:| | |會 |會
    Read the rules
    Use code tags to [code]enclose your code![/code]
    Reply With QuoteRegister To Reply
+ Reply to Thread
« Previous Thread | Next Thread »

Thread Information

Users Browsing this Thread

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

Similar Threads

  1. Can someone help me Improve my code, please?
    By Energy48 in forum Excel Programming / VBA / Macros
    Replies: 1
    Last Post: 01-09-2023, 05:56 PM
  2. How to improve my code ?
    By ozstrik3r69 in forum Excel Programming / VBA / Macros
    Replies: 3
    Last Post: 10-23-2017, 08:51 AM
  3. Improve my code: If, or, then
    By Alex532 in forum Excel Programming / VBA / Macros
    Replies: 5
    Last Post: 04-01-2013, 07:19 PM
  4. [SOLVED] To improve Efficiency of code, code running too long
    By andywsw in forum Excel Programming / VBA / Macros
    Replies: 5
    Last Post: 06-19-2012, 05:54 PM
  5. [SOLVED] Anyone help to improve my code?
    By Andrew in forum Excel Programming / VBA / Macros
    Replies: 3
    Last Post: 05-05-2006, 10:15 AM
  6. Re: Improve code
    By rjamison in forum Excel Programming / VBA / Macros
    Replies: 0
    Last Post: 06-13-2005, 08:05 PM
  7. [SOLVED] Improve code
    By Gareth in forum Excel Programming / VBA / Macros
    Replies: 5
    Last Post: 04-20-2005, 11:06 AM

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

Forum Rules


Search Engine Friendly URLs by vBSEO 3.6.0 RC 1