• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

VBA Error Handling Help

I have some code that uses Auto Filter to copy the matching data from the master workbook called Intercompany or wsIC in the code to a matching workbook called myFile.

My issue is if I have a workbook in the folder and there is no match for the RepName in wsIC the code writes all the data in wsIC into myFile. What I want it to do is if no match is found then copy nothing and move to the next workbook.

Below is the part of the code I need to fix:

Code:
 Do While myFile <> "" 'Loop through each Excel file in folder
  Set wb = Workbooks.Open(Filename:=myPath & myFile) 'Set variable equal to opened workbook
  wb.Worksheets.Add(After:=Worksheets(1)).Name = "IC" 'With opened workbook add a sheet and rename
  With Worksheets("IC")
  .Range("A1:H1").Value = ColHeads
  .Range("A1:H1").Font.Bold = True
  .Columns("A:H").AutoFit
  End With
  
  RepName = Left(myFile, InStr(myFile, " ") - 1) 'extracts the Rep Name from the file name. -1 for removing space
  
  '****************************************************************************************************************
  '================================================================================================================
  'Need error handling so if a rep has no IC Commission nothing will be copied to the workbook
  '================================================================================================================
  '****************************************************************************************************************
  'copy matching data from IC to opened workbook aka myFile
  With wsIC
  .Cells(1).AutoFilter Field:=4, Criteria1:="=" & RepName
  With .AutoFilter.Range
  If .Rows.Count > 1 Then 'there is at least 1 row which meets the filter criteria
  For i = LBound(ColHeads) To UBound(ColHeads)
  ColNum = .Rows(1).Find(ColHeads(i)).Column
  .Columns(ColNum).Offset(1).Resize(.Rows.Count - 1).Copy Destination:=wb.Worksheets("IC").Cells(2, i + 1)
  'offset 1 row to exclude the header row. +1 for first value of i = 0 ColHeads is zero based array
  Next i
  End If
  End With
  End With
  
  StartRow = 2
  EndRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
  
  Cells(EndRow, 1).Value = "Total"
  Cells(EndRow, 8).FormulaR1C1 = "=Sum(R[" & StartRow - EndRow & "]C:R[-1]C)"
  
  Set wsCS = Worksheets("Commission Summary")
  Set wsM3 = Worksheets("M3")
  
  With wsIC
  LastRow1 = Cells(.Cells.Rows.Count, "H").End(xlUp).Row - 1
  End With
  wsCS.Range("B3") = "=Sum(IC!H2:H" & LastRow1 & ")"
  'add total of column H of IC worksheet to Commission Summary worksheet.
  
  With wsM3
  LastRow = .Cells(.Rows.Count, "P").End(xlUp).Row
  End With
  wsCS.Range("B2") = "=sum(M3!P" & LastRow & ")"
  LastRow = Empty
  'Add total of column P of M3 worksheet to Commission Summary worksheet
  
  wb.Close SaveChanges:=True
  myFile = Dir 'Get next file name
  Loop[\code]
 
It looks like the problem then is when RepName = "", correct?
Code:
Do While myFile <> "" 'Loop through each Excel file in folder
    Set wb = Workbooks.Open(Filename:=myPath & myFile) 'Set variable equal to opened workbook
    wb.Worksheets.Add(After:=Worksheets(1)).Name = "IC" 'With opened workbook add a sheet and rename
    With Worksheets("IC")
        .Range("A1:H1").Value = ColHeads
        .Range("A1:H1").Font.Bold = True
        .Columns("A:H").AutoFit
    End With
   
    RepName = Left(myFile, InStr(myFile, " ") - 1) 'extracts the Rep Name from the file name. -1 for removing space
   
    '****************************************************************************************************************
    '================================================================================================================
    'Need error handling so if a rep has no IC Commission nothing will be copied to the workbook
    '================================================================================================================
    '****************************************************************************************************************
    'copy matching data from IC to opened workbook aka myFile
   
    '----New code by Luke M----
    If RepName <> "" Then
        With wsIC
            .Cells(1).AutoFilter Field:=4, Criteria1:="=" & RepName
            With .AutoFilter.Range
                If .Rows.Count > 1 Then 'there is at least 1 row which meets the filter criteria
                    For i = LBound(ColHeads) To UBound(ColHeads)
                        ColNum = .Rows(1).Find(ColHeads(i)).Column
                        .Columns(ColNum).Offset(1).Resize(.Rows.Count - 1).Copy Destination:=wb.Worksheets("IC").Cells(2, i + 1)
                        'offset 1 row to exclude the header row. +1 for first value of i = 0 ColHeads is zero based array
                    Next i
                End If
            End With
        End With
       
        StartRow = 2
        EndRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
       
        Cells(EndRow, 1).Value = "Total"
        Cells(EndRow, 8).FormulaR1C1 = "=Sum(R[" & StartRow - EndRow & "]C:R[-1]C)"
       
        Set wsCS = Worksheets("Commission Summary")
        Set wsM3 = Worksheets("M3")
       
        With wsIC
            LastRow1 = Cells(.Cells.Rows.Count, "H").End(xlUp).Row - 1
        End With
        wsCS.Range("B3") = "=Sum(IC!H2:H" & LastRow1 & ")"
        'add total of column H of IC worksheet to Commission Summary worksheet.
       
        With wsM3
            LastRow = .Cells(.Rows.Count, "P").End(xlUp).Row
        End With
        wsCS.Range("B2") = "=sum(M3!P" & LastRow & ")"
       
    End If
    LastRow = Empty
    'Add total of column P of M3 worksheet to Commission Summary worksheet
   
    wb.Close SaveChanges:=True
    myFile = Dir 'Get next file name
Loop
 
Correct Luke. I added the additional lines of code and it still is doing the samething.

I need the code to somehow say if the RepName does not match the auto filter then do nothing.

I am wondering if this line needs changing?

Code:
 If .Rows.Count > 1 Then 'there is at least 1 row which meets the filter criteria
 
I guess I'm not sure what you mean by "RepName does not match the auto filter". When you run the code, what is happening? Can you try stepping through the code (use F8), and see exactly what is going wrong?
We could also try adding in some debug lines, like perhaps putting
Code:
Debug.Print RepName
after the new If statement, just to see what the code sees.
 
Luke,

RepName would be an existing workbook named Smith 04-15.xlxs

This line of code extracts the name only:
Code:
RepName = Left(myFile, InStr(myFile, " ") - 1) 'extracts the Rep Name from the file name. -1 for removing space

I have about 40 workbooks for the different reps where I get RepName from. In another workbook called Intercompany, I may have only 20 of the names that match the RepName workbook. The macro copies the data well as long as it finds a match for the RepName in the IC workbook. When a match is not found, it copies all the data from the IC workbook into the rep workbook. What it should do is nothing and move on to the next RepName.

After inserting the debug line, the code is reading the names.

So, RepName = Smith
If Smith is found in the IC workbook copy only Smith's data into his workbook.
If Smith is not found in the IC workbook, do nothing and move on to the next workbook.

Maybe I should use something like this:
Code:
For i = 2 To LastRow
If Cells(i, 4) = RepName Then
Range(Cells(i, 1), Cells(i, 7)).Select
Selection.Copy

But I'm not sure how to intigrate that into the macro.
 
Ah ha, I see now!

In the code, we're currently quering how many rows are in the filter, but we really want to know about the VISIBLE rows. Change the row count check line to be:
Code:
'Need to actually check if the VISIBLE rows are greater than 1
If .SpecialCells(xlCellTypeVisible).Rows.Count > 1 Then 'there is at least 1 row which meets the filter criteria
 
That doesn't make sense. We only changed an If check, not what was actually getting copied. Can you step through the code, try to figure out when/where things are going screwy?
 
OK, it looks like here is where things are going wrong:

Code:
For i = LBound(ColHeads) To UBound(ColHeads)
  ColNum = .Rows(1).Find(ColHeads(i)).Column
  .Columns(ColNum).Offset(1).Resize(.Rows.Count - 1).Copy Destination:=wb.Worksheets("IC").Cells(2, i + 1)

What the code is doing is copying the number of visible cells for each column. So, if the AutoFilter has no match then all cells are visible and it copys them.

Any ideas?
 
So, if the AutoFilter has no match then all cells are visible and it copys them.

Any ideas?
If an Autofilter has no match, then none of the cells should be visible. Are you saying that when it runs the AutoFilter, nothing happens?
 
"So, if the AutoFilter has no match then all cells are visible and it copys them."

I meant to say all cells are "not" visible.

When I run the macro without SpecialCells(xlCellTypeVisible) the macro copies the data fine for any match but all the data when a match is not found.

When I add the adjustment that you suggested, when I look at the IC workbook as it goes through the code, it is filtered based on the RepName. But when it copies it copies nothing. Which I find odd because there are visible cells.

I wonder if this line is causing the issue in the loop I posted:

Code:
ColHeads = Array("Client Name", "Service", "Start Date", "Rep", "First Year Comm %", "Residual Commission", d & " IC Revenue", d & " Commission")

I need the array because where "d" is relates to the current month and the months are in columns G thru AD, one column for revenue and one for commission.

I did notice that in this line of code the row count was 12 but there were no visible cells for that rep. The rep also had no matching data.

Code:
 If .SpecialCells(xlCellTypeVisible).Rows.Count > 1 Then 'there is at least 1 row which meets the filter criteria
 
Here's full code I'm working with atm, with some added debug lines. Can you run and see what prints out?
Code:
Sub SomeMacro()


Dim RepName As String
Dim ColNum As String
Dim ColHeads() As String
Dim myFile As String
Dim wb As Workbook
Dim wsIC As Worksheet
Dim wsCS As Worksheet
Dim wsM3 As Worksheet
Dim myPath As String
Dim i As Long
Dim endRow As Long
Dim startRow As Long
Dim lastRow1 As Long
Dim lastRow As Long

'OTHER STUFF HERE

Do While myFile <> "" 'Loop through each Excel file in folder
   Set wb = Workbooks.Open(Filename:=myPath & myFile) 'Set variable equal to opened workbook
   wb.Worksheets.Add(After:=Worksheets(1)).Name = "IC" 'With opened workbook add a sheet and rename
   With Worksheets("IC")
        .Range("A1:H1").Value = ColHeads
        .Range("A1:H1").Font.Bold = True
        .Columns("A:H").AutoFit
    End With
   
    RepName = Left(myFile, InStr(myFile, " ") - 1) 'extracts the Rep Name from the file name. -1 for removing space
    '****************************************************************************************************************
   '================================================================================================================
   'Need error handling so if a rep has no IC Commission nothing will be copied to the workbook
   '================================================================================================================
   '****************************************************************************************************************
   'copy matching data from IC to opened workbook aka myFile
    '----New code by Luke M----
   If RepName <> "" Then
        With wsIC
            .Cells(1).AutoFilter Field:=4, Criteria1:="=" & RepName
            With .AutoFilter.Range
                'there is at least 1 row which meets the filter criteria...
                'CHECKING...
                Debug.Print "# of results for " & RepName & ": " & .SpecialCells(xlCellTypeVisible).Rows.Count
               
                If .SpecialCells(xlCellTypeVisible).Rows.Count > 1 Then
                   For i = LBound(ColHeads) To UBound(ColHeads)
                        ColNum = .Rows(1).Find(ColHeads(i)).Column
                        'More checks
                        Debug.Print ColHeads(i) & " was found in col # :" & ColNum
                       
                        .Columns(ColNum).Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Copy _
                            Destination:=wb.Worksheets("IC").Cells(2, i + 1)
                        'offset 1 row to exclude the header row. +1 for first value of i = 0 ColHeads is zero based array
                   Next i
                End If
            End With
        End With
       
        startRow = 2
        endRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
       
        Cells(endRow, 1).Value = "Total"
        Cells(endRow, 8).FormulaR1C1 = "=Sum(R[" & startRow - endRow & "]C:R[-1]C)"
       
        Set wsCS = Worksheets("Commission Summary")
        Set wsM3 = Worksheets("M3")
       
        With wsIC
            lastRow1 = .Cells(.Cells.Rows.Count, "H").End(xlUp).Row - 1
        End With
        wsCS.Range("B3") = "=Sum(IC!H2:H" & lastRow1 & ")"
        'add total of column H of IC worksheet to Commission Summary worksheet.
     
        With wsM3
            lastRow = .Cells(.Rows.Count, "P").End(xlUp).Row
        End With
        wsCS.Range("B2") = "=sum(M3!P" & lastRow & ")"
       
    End If
    lastRow = Empty
    'Add total of column P of M3 worksheet to Commission Summary worksheet
    wb.Close SaveChanges:=True
    myFile = Dir 'Get next file name
Loop
End Sub
 
May the force be with you Luke. I amended the code. Ran it and no records copied.

Here are the results from the Immediate window:

Initializing resources for Office Edition (Excel)
LocalizationContext object created successfully
About to laod resources from local machine.
Successfully loaded resources from local machine for user default locale.
# of results for Derrick: 1
# of results for Betts: 1
# of results for Beck: 1
# of results for Bissot: 1
# of results for Beckman: 1
# of results for Ash: 1
# of results for Carr: 1

What actually should have copied:
# of results for Derrick: 18
# of results for Betts: 0
# of results for Beck: 4
# of results for Bissot: 2
# of results for Beckman: 0
# of results for Ash: 8
# of results for Carr: 0
 
Ah, I just learned something. The VisibleCells doesn't correctly count rows in a filter. Lovely...
Thankfully, found the workaround.
http://www.contextures.com/xlautofilter03.html#Count
We need to check just 1 column. Ammending my code above gives:
Code:
If RepName <> "" Then
        With wsIC
            .Cells(1).AutoFilter Field:=4, Criteria1:="=" & RepName
            With .AutoFilter.Range
                'there is at least 1 row which meets the filter criteria...
               'CHECKING...
               Debug.Print "# of results for " & RepName & ": " & .Columns(1).SpecialCells(xlCellTypeVisible).Count
               
                If .Columns(1).SpecialCells(xlCellTypeVisible).Count > 1 Then
                   For i = LBound(ColHeads) To UBound(ColHeads)
                        ColNum = .Rows(1).Find(ColHeads(i)).Column
                        'More checks
                       Debug.Print ColHeads(i) & " was found in col # :" & ColNum
                       
                        .Columns(ColNum).Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Copy _
                            Destination:=wb.Worksheets("IC").Cells(2, i + 1)
                        'offset 1 row to exclude the header row. +1 for first value of i = 0 ColHeads is zero based array
                  Next i
                End If
            End With
        End With
 
I get a Run-Time Error 438
Object dosen't support this property or method

On this line:

Code:
.Columns(1).SpecialCells(xlCellTypeVisible).Count
 
OK, fixed my mistake.

Got a Run-time Error 1004
Aplication-defined orobject-defined error

On this line:
Code:
.Columns(ColNum).Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Copy Destination:=wb.Worksheets("IC").Cells(2, i + 1)
 
Here are the results of the Debug:

# of results for Derrick: 19
Client Name was found in col # :1

We should be looking in column 4.
 
So, now the wrong column is getting found?? Even odder. Okay, let's check that part out. We'll first verify which cell the code thinks it's looking at. I'm not sure what is causing the error yet...
Code:
Dim fCell As Range

If RepName <> "" Then
    With wsIC
        .Cells(1).AutoFilter Field:=4, Criteria1:="=" & RepName
        With .AutoFilter.Range
            'there is at least 1 row which meets the filter criteria...
            'CHECKING...
            Debug.Print "# of results for " & RepName & ": " & .Columns(1).SpecialCells(xlCellTypeVisible).Count - 1
           
            If .Columns(1).SpecialCells(xlCellTypeVisible).Count - 1 > 0 Then
                For i = LBound(ColHeads) To UBound(ColHeads)
                    Set fCell = .Rows(1).Find(ColHeads(i))
                    Debug.Print ColHeads(i) & " was found in " & fCell.Address
                    ColNum = fCell.Column
                    Debug.Print ColHeads(i) & " was found in col#: " & ColNum
                   
                    .Columns(ColNum).Offset(1).Resize(.Rows.Count - 1).Copy _
                        Destination:=wb.Worksheets("IC").Cells(2, i + 1)
                    'offset 1 row to exclude the header row. +1 for first value of i = 0 ColHeads is zero based array
                Next i
            End If
        End With
    End With
 
OK Luke, I made some workbooks for you. I could only download 3. I am going to put some more in another reply.

Maybe this will clear things up a bit.

On the macro reading teh wrong column, that was because when the macro runs it copies one column at a time using the array. So it found nothing and the result of the debug was 1.
 

Attachments

  • Abbott 04-15.xlsx
    18.3 KB · Views: 0
  • 2015 Intercompany Billing.xlsx
    40.8 KB · Views: 0
  • Sales Commissions Macro V4 WORKS.xlsm
    271.6 KB · Views: 0
Here are more workbooks...

BTW, the macro workbook is the original code before we started modifying it.
 

Attachments

  • Davis 04-15.xlsx
    19.6 KB · Views: 0
  • Jones 04-15.xlsx
    40.4 KB · Views: 0
  • Smith 04-15.xlsx
    32.8 KB · Views: 0
One more thing, if you take one of the workbooks like Abbott and name it Luke and run the macro you will see that it will copy all the IC data into it when it should do nothing.
 
Wonderful, thanks for the files. Looks like there were a couple cases of undefined variables, some With statements that weren't getting traced back up to, and some sheets that didn't have parent workbook defined. I've gone through the whole macro and it seems to be working now with sample files you gave me.

Definition of success:
If file has no recs found in Billings sheet, then file is closed, no changes made.
Otherwise, Records for the Rep copied to new IC sheet, total line added to bottom of data.


PS. As a future tip in this forum, you can upload a Zip file, which is handy when you have many files you want to share. :)
 

Attachments

  • Sales Commissions Macro V4 LM.xlsm
    276.1 KB · Views: 3
SUCCESS!!!!! I owe you a box of Krisy Kreams! They are awful good!

In going through the code how in the world did you figure it out?
 
Back
Top