Posts by cdug

Re: Sort every worksheet by date

It is still showing an error message unfortunately

Re: Sort every worksheet by date

Thank you! However when I use this (changing ws to wsheet) it says sort method of range class failed

Sub EliminateBlanks()
Dim wsheet As Worksheet
For Each wsheet In Worksheets
If wsheet.Name <> "Updates" Or wsheet.Name <> "ASH" Then
    wsheet.Sort.SortFields.Clear
    wsheet.Sort.SortFields.Add Key:=Range("A2:A2108"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With wsheet.Sort
        .SetRange Range("A1:I2108")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    
End If
Next wsheet
    
End Sub

So this code doesn't work. I recorded a macro and then changed it to be applied to all worksheets in the workbook. It doesn't like ".Apply" but when I take it out, there is no error message, but it does not sort the data.

I have the following code which works perfectly until I want not just today's date, but the past 5 days as well

Sub RecentUpdates()
Dim x As Integer
Dim NextRow As Range
Dim WhatToCopy As String
Dim wsheet As Worksheet
For Each wsheet In Worksheets
    If wsheet.name <> "Updates" Then
    x = 2
    
    Set NextRow = Sheets("Updates").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
        Do Until x > 500 Or wsheet.Range("A" & x) = ""
            If wsheet.Range("A" & x) = Date Then
               wsheet.Rows(x).EntireRow.Copy NextRow
            End If
            If wsheet.Range("D" & x) = Date Then
               wsheet.Rows(x).EntireRow.Copy NextRow
            End If
            Set NextRow = Sheets("Updates").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
            x = x + 1
        Loop
    End If
Next wsheet
End Sub

I've tried

If wsheet.Range("A" & x) = Date or Date - 1 or Date - 2 or Date - 3 or Date - 4 or Day - 5 Then

however, this copies every date, even if they are way older than the previous 5 days days. How do I modify so that it will copy and paste all dates that are within the past 5 days from today?

Re: VBA to copy and paste certain cells if cell contains today's date or the past 5 d

I got this, but I can't figure out how to apply that to every sheet. Also, how would I delete duplicates on the Updates page so that when the macro runs, it won't keep pasting the same thing.

Sub RecentUpdates()
Dim X As Integer
Dim NextRow As Range


X = 2
Set NextRow = Sheets("Updates").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
    Do Until X > 5000
       
        If Range("A" & X) = Date Then
            Rows(X).EntireRow.Copy NextRow
        End If
        
        Set NextRow = Sheets("Updates").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
        X = X + 1
    
    Loop
    
End Sub

Edit: I figured how to remove duplicates with

Sub DeleteDuplicates()
    
    Range("A1:G5000").RemoveDuplicates Columns:=Array(6), Header:=xlYes
    
End Sub

However, I still can't figure out to run the first code through every page. Also, my code only checks to see if it is equal to today's date, how do I get it to check the past 5 days as well? In addition, by copying and pasting, it takes a lot of time, how do I speed this process up?

So if column A or D contains today's date or the past 5 days, I need to copy that row plus cell F1 and paste it to another sheet on the next blank row. I need to do this for every sheet in the workbook, is there a loop that will do this rather than having separate code for every sheet? Thank you

So I will try to be as specific and clear as possible. I am trying to pull today's date from multiple different workbooks and multiple different sheets. There is a total of 14 workbooks and 980 worksheets and opening and closing the workbooks is not going to work as I have already tried this and it takes way too long (very slow shared network). I need one workbook to pull today's date from all 980 sheets (if it is even there) and display what workbook and worksheet it is coming from. Thank you very much!

Re: Copy every 18 cells in a column (A) and paste in multiple columns (C __>

Sub Macro()
    Dim a As Integer
    Dim b As Integer
    Dim c As Integer
    Dim CopyRange As String
    a = 2
    b = 19
    c = 3
    Do Until a > 5000
        Let CopyRange = "A" & a & ":" & "A" & b
        Range(CopyRange).Copy Cells(2, c)
        a = a + 18
        b = b + 18
        c = c + 1
    Loop
 
End Sub

Is this what you are looking for?

Re: Copy every 18 cells in a column (A) and paste in multiple columns (C __>

I Just realized I misread your post. So this isn't correct, but let me try to fix it.

Sub Macro()
 Dim a As Integer
 Dim b As Integer
a = 2
 b = 3
 Do Until a > 5000
   Cells(a, 1).Copy Cells(2, b)
   a = a + 18
   b = b + 1
 Loop
End Sub

Try this:

Sub Macro() 
    Dim a As Integer 
    Dim b As Integer 
    Dim c As Integer 
    Dim CopyRange As String 
    a = 2 
    b = 19 
    c = 3 
    Do Until a > 5000 
        Let CopyRange = "A" & a & ":" & "A" & b 
        Range(CopyRange).Copy Cells(2, c) 
        a = a + 18 
        b = b + 18 
        c = c + 1 
    Loop 
     
End Sub

Re: Stop Application.Ontime to stop running upon closing so that it won't open back u

My mistake, I forgot to add On Error Resume Next and it works now!! Thank you very much!!

Re: Stop Application.Ontime to stop running upon closing so that it won't open back u

I got an error message with that extra comma now. Run-time error 1004 Method 'onTime of object'_application' failed

Re: Stop Application.Ontime to stop running upon closing so that it won't open back u

.

Re: Stop Application.Ontime to stop running upon closing so that it won't open back u

Thanks for the response! So this stops the timer when I run the macro. However, when I close the file, it will open back again if I have another file open too. This makes me wonder if it is stopping it or not when the file is closing. Could it be something wrong with

Private Sub Workbook_BeforeClose(Cancel As Boolean) 
    Call StopRefresh 
End Sub

Sub Refresh()   'This automatically refreshes the time every 10 seconds
    Application.OnTime Now + TimeValue("00:00:10"), "refresh"
    Application.Calculate
End Sub
Sub StopRefresh()
Application.OnTime Now + TimeValue("00:00:10"), "refresh", False
End Sub

Private Sub Workbook_Open()
    Call Refresh
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Call StopRefresh
End Sub

I'm not sure why the stop refresh isn't working. Should I use something different? The refresh is essentially just calculating every 10 seconds and I need this to stop when the workbook closes. Thank you.