Thread: Macros for multiple files

Hold on a moment...have a problem with the code I just posted.

Hi Regan

Try this...has to rewrite the Filter Routine

Option Explicit
Sub Combine_Days()
    Dim LR As Long
    Dim dayCol As String
    Dim dataCol As String
    Dim i As Long
    Dim x As Long
    Dim Rng As Range
    Application.ScreenUpdating = False
    dayCol = ColumnLetter(WorksheetFunction.Match("Number of Days", Rows("1:1"), 0))
    dataCol = ColumnLetter(WorksheetFunction.Match("Data", Rows("1:1"), 0))
    With ActiveSheet
        LR = .Range(dayCol & .Rows.Count).End(xlUp).Row
        'filter unwanted records
        .Range(dayCol & "1:" & dayCol & LR).AutoFilter Field:=1, Criteria1:= _
                "=1-2 days", Operator:=xlOr, Criteria2:="="
        Set Rng = .AutoFilter.Range
        With Rng
            x = Rng.Columns(1).SpecialCells(xlCellTypeVisible).Count
            If x > 1 Then
                .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
            End If
        End With
        .AutoFilterMode = False
    End With
    LR = Range(dayCol & Rows.Count).End(xlUp).Row
    Set Rng = Range(dayCol & "2:" & dayCol & LR)
    With Rng
        For i = LR To 1 Step -1
                If Rng(i).Value = "2 days" And Rng(i).Offset(-1, 0) = "1 day" Then
                    Rng(i).Offset(1, 0).EntireRow.Insert
                    Rng(i).EntireRow.Copy
                    Range("A" & Rng(i).Row).EntireRow.Copy
                    Range("A" & Rng(i).Row).Offset(1, 0).PasteSpecial
                    Range(dayCol & Rng(i).Row).Offset(1, 0).Value = "1-2 days"
                    ' allow N/A & LNE records to be processed
                    On Error Resume Next
                    Range(dataCol & Rng(i).Row).Offset(1, 0).Value = Application.WorksheetFunction.Sum _
                            (Range(dataCol & Rng(i).Row).Offset(0, 0).Value, Range(dataCol & Rng(i).Row).Offset(-1, 0).Value)
                    On Error GoTo 0
                    Rng(i).EntireRow.Delete
                    Rng(i).Offset(-1, 0).EntireRow.Delete
                End If
            Next
        End With
        Application.ScreenUpdating = True
    End Sub

Hi Regon
Sorry, I didn't include the Function in the last code I posted. Copy this code to the same module immediately after the Combine_Days routine.

Function ColumnLetter(ColumnNumber As Long) As String
' From http://www.craigmurphy.com/blog/?p=150
' Works in Excel 2007
    Dim ColNum As Integer
    Dim ColLetters As String
    ColNum = ColumnNumber
    ColLetters = ""
    Do
        ColLetters = Chr(((ColNum - 1) Mod 26) + 65) & ColLetters
        ColNum = Int((ColNum - ((ColNum - 1) Mod 26)) / 26)
    Loop While ColNum > 0
    ColumnLetter = ColLetters
End Function

Oh my gosh, you are a genius! Seriously, this is amazing. It works on two thirds of my files - the other files have a different layout though, so this is to be expected. You have already done so much already, so you don't have to work on this too, but I was wondering if I can just amend the code to work on the remaining files.

In the files, I want to combine the '4-6 times' and '7 or more times' rows into '4 Times or More'
And combine the '2 times' and '3 times' into '2-3 Times'

The file has the following headers:
Grade_Level Gender Number of Times Data Location Time_Frame Location_Code

I tried amending the code myself, but it didn’t work. Can you tell what I am doing wrong? And again, thank you so much for your help!

Option Explicit
Sub Combine_Days()
    Dim LR As Long
    Dim timeCol As String
    Dim dataCol As String
    Dim i As Long
    Dim x As Long
    Dim Rng As Range
    Application.ScreenUpdating = False
    timeCol = ColumnLetter(WorksheetFunction.Match("Number of Times", Rows("1:1"), 0))
    dataCol = ColumnLetter(WorksheetFunction.Match("Data", Rows("1:1"), 0))
    With ActiveSheet
        LR = .Range(timeCol & .Rows.Count).End(xlUp).Row
        'filter unwanted records
        .Range(timeCol & "4-6 times:" & timeCol & LR).AutoFilter Field:=1, Criteria1:= _
                "=4 Times or More", Operator:=xlOr, Criteria2:="="
        Set Rng = .AutoFilter.Range
        With Rng
            x = Rng.Columns(1).SpecialCells(xlCellTypeVisible).Count
            If x > 1 Then
                .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
            End If
        End With
        .AutoFilterMode = False
    End With
    LR = Range(timeCol & Rows.Count).End(xlUp).Row
    Set Rng = Range(timeCol & "2:" & timeCol & LR)
    With Rng
        For i = LR To 1 Step -1
                If Rng(i).Value = "7 or more times" And Rng(i).Offset(-1, 0) = "4-6 times" Then
                    Rng(i).Offset(1, 0).EntireRow.Insert
                    Rng(i).EntireRow.Copy
                    Range("A" & Rng(i).Row).EntireRow.Copy
                    Range("A" & Rng(i).Row).Offset(1, 0).PasteSpecial
                    Range(timeCol & Rng(i).Row).Offset(1, 0).Value = "4 Times or More"
                    ' allow N/A & LNE records to be processed
                    On Error Resume Next
                    Range(dataCol & Rng(i).Row).Offset(1, 0).Value = Application.WorksheetFunction.Sum _
                            (Range(dataCol & Rng(i).Row).Offset(0, 0).Value, Range(dataCol & Rng(i).Row).Offset(-1, 0).Value)
                    On Error GoTo 0
                    Rng(i).EntireRow.Delete
                    Rng(i).Offset(-1, 0).EntireRow.Delete
                End If
            Next
        End With
        Application.ScreenUpdating = True
    End Sub
    
    Function ColumnLetter(ColumnNumber As Long) As String ' From http://www.craigmurphy.com/blog/?p=150
' Works in Excel 2007
    Dim ColNum As Integer
    Dim ColLetters As String
    ColNum = ColumnNumber
    ColLetters = ""
    Do
        ColLetters = Chr(((ColNum - 1) Mod 26) + 65) & ColLetters
        ColNum = Int((ColNum - ((ColNum - 1) Mod 26)) / 26)
    Loop While ColNum > 0
    ColumnLetter = ColLetters
End Function

Hi Regon
First thing you GOTTA DO...always use code tags around your code or you'll get hammered by the Moderators (see Rule #3). To add code tags :

3. Use code tags around code. Posting code without them makes your code hard to read and difficult to be copied for testing.
Select your code and click the [#] button at the top of the post window (if you are editing an existing post, press Go Advanced
to see the [#] button). Highlight your code then press the [#] button. The result will appear like this in the post window:

your code here ...
and here ...
and here

In the meantime, I'll look at this. I may need a file.

Hi Regan
Nah, you can't wait until tomorrow. You need to edit your post #35 to include Code Tags. To do so:
press Edit Post, press Go Advanced to see the [#] button). Highlight your code then press the [#] button. Press Save Changes. The result will appear like this in the post window:

your code here ...
and here ...
and here

Not my rules Bud...but they make sense.

Hi Regan
That looks much better! Thanks.
Of course, I can't test the code but this line jumps out

With ActiveSheet
        LR = .Range(timeCol & .Rows.Count).End(xlUp).Row
        'filter unwanted records
        .Range(timeCol & "4-6 times:" & timeCol & LR).AutoFilter Field:=1, Criteria1:= _
                "=4 Times or More", Operator:=xlOr, Criteria2:="="    
    Set Rng = .AutoFilter.Range
        With Rng
            x = Rng.Columns(1).SpecialCells(xlCellTypeVisible).Count
            If x > 1 Then
                .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
            End If
        End With
        .AutoFilterMode = False
    End With

Take a look at that line compared to the original code, specifically at

timeCol & "4-6 times:"  Which is meaningless.

Whereas the original code was

.Range(dayCol & "1:"

Your code should probably be

.Range(timeCol & "1:"

Can't guarantee this'll fix it but give it a try. Let me know how you make out.

FYI: This could probably all be incorporated into one macro that'll work on ALL files. If you're interested, send me a copy of the most recent file. You have my email address.

Include the Function Code ONLY once...you have two copies of it.

 Function ColumnLetter(ColumnNumber As Long) As String ' From http://www.craigmurphy.com/blog/?p=150
' Works in Excel 2007
    Dim ColNum As Integer
    Dim ColLetters As String
    ColNum = ColumnNumber
    ColLetters = ""
    Do
        ColLetters = Chr(((ColNum - 1) Mod 26) + 65) & ColLetters
        ColNum = Int((ColNum - ((ColNum - 1) Mod 26)) / 26)
    Loop While ColNum > 0
    ColumnLetter = ColLetters
End Function

Get rid of either one...matters not which.

We'll work on this after you've played with things...perhaps you will have done most of the coding

It would be great if I could have all of this in one macro so that I would only have to run it once. Happy to take a work-around though

Hi Regan

You're welcome...glad I could be of help. If that satisfies your need, I'd appreciate it if you'll please mark your thread as "Solved".

To mark your thread solved do the following:
- Go to your first post on the thread
- Click edit
- Click Advance
- Just below the word "Title:" you will see a dropdown with the word No prefix.
- Change to Solved
- Click Save