Advanced VBA errors, need guidance! 2

[lespaul]

Hello all, I have a spreadsheet that Dale and others helped with, and I'm having to make changes and fix problems and Dale's no longer really "available". So hopefully one of you will be able to assist me.

I have a spreadsheet to which I export raw data (to the 'DATA' sheet). This information includes the name, address, etc, juror hours, juror payment due, juror mileage, juror mileage due.

I then have a macro that should clear any existing data on the 'Voucher Report' page, check that juror payment due + juror mileage due = 0 and if it does DELETE THAT ROW SO NO PAYMENT IS PROCESSED AND THE PERSON DOESN'T SHOW UP ON THE VOUCHER PAGE. As I have found previously, deleting a row can cause problems!

I thought I was making progress on the checking for zero value, but now, early code is failing! I would appreciate some guidance and help. I can email the spreadsheet if anyone can take a look at it for me!

Thanks!



Leslie
landrews@metrocourt.state.nm.us

There are 10 types of people in the world -
those who understand binary
and
those who don't!

 

[kphu]

Hi Leslie,

Instead of deleting the row. Can you just clear the contents so that it doesn't calculate the values in it?

 

[lespaul]

I could but the Voucher Report would then have blank cells!

Leslie
landrews@metrocourt.state.nm.us

There are 10 types of people in the world -
those who understand binary
and
those who don't!

 

[kphu]

Leslie,

Can you provide me with more information on the data sheet? How that sheet references the voucher report page.

I'm assuming that the voucher report page and the data sheet page is within the same workbook.

 

[Zathras]

Leslie, you said you could blank the row. Then take a look at the function I provided in thread707-526455 called "DeleteZeroRows" and see if that can be of any use.

 

[lespaul]

I'm getting ready to leave for the day, so I'll check it out in the morning. Basically here's what I have:
Data Sheet
Name Address City State Zip JurorHours JurorPay JurorMileage JurorMilePay TotalPay

I have a formatted 'Voucher Report' that combines the name & address into one cell, the jurorpay & jurorMilePay are transferred from the data sheet. This report is for our accounting department and we don't want people who aren't getting paid to show up on the voucher report. So prior to transferring the data, I want to delete all the people on the Data sheet who don't get a check!

Dale has helped with this and I have also gotten some help from here, but I'm confused!

Thanks for all the insight, back at it tomorrow!

Leslie
landrews@metrocourt.state.nm.us

There are 10 types of people in the world -
those who understand binary
and
those who don't!

 

[lespaul]

Zathras,
I looked at your delete code, but couldn't get it to work. Here is the code that I am currently running (Dale's assistance) and I'm not completely sure what's doing what!
I think that the 'namelist' is the range on my Data Sheet which is what I want to delete the 0's from before transfering to the VoucherReport.

Thanks!

Sub Generate_VoucherRpt()
    Application.ScreenUpdating = False
    Delete_Existing
    Set_Range
    Copy_Formulas
    Application.CutCopyMode = False
    Application.Goto Reference:="R1C1"
    Application.ScreenUpdating = True
End Sub

Sub Delete_Existing()
'removes existing data from Voucher Report
'prior to generating a new report.
    Sheets("VoucherReport").Select
    Application.Goto Reference:="frms"
    ActiveCell.Offset(1, 0).Select
    ActiveCell.Value = "Filler"
    FirstCell = ActiveCell.Address
    LastCell = [A65536].End(xlUp).Address
    datalist = FirstCell & ":" & LastCell
    Range(datalist).EntireRow.Delete
End Sub

Sub Set_Range()
'sets the new range, to which the formulas
'will be copied.
    numrows = Range("namecnt").Value
    Application.Goto Reference:="frms"
    ActiveCell.Offset(1, 0).Select
    FirstCell = ActiveCell.Address
    LastCell = Cells(numrows, 1).Address
    datalist = FirstCell & ":" & LastCell
    Range(datalist).Name = "namelist"
End Sub

Sub Copy_Formulas()
'copies the formulas ("frms") to the range "namelist"
    Range("frms").Copy
    Range("namelist").Select
    ActiveSheet.Paste
End Sub

Leslie
landrews@metrocourt.state.nm.us

There are 10 types of people in the world -
those who understand binary
and
those who don't!

 

[Zathras]

Assuming that you have blanked or zeroed every cell in the row that should be skipped, it looks like you should be able to put this line:

  DeleteZeroRows("frms")

just in front of the line that says

  Range("frms").Copy

Be sure to copy the entire subroutine "DeleteZeroRows" from thread707-526455 into your code module.

 

[lespaul]

So I did that and it deletes ALL the data in my datasheet regardless of what the information is! I created a new range named PaidJurors that is from A2 to G200 (there will never be more than 200 people being paid at one time). I have passed "paidjurors" to the DeleteZeroRows and it deletes them all.

So my data worksheet is laid out as indicated above. The VoucherReport has the following formula in the 2nd row:
A: =Data!A2&CHAR(10)&" "&Data!B2&CHAR(10)&" "&Data!C2
B: =Data!D2
C: =ROUND(VALUE(Data!E2),2)
D: =Data!F2
E: =ROUND(VALUE(Data!G2),2)
F: =C2+E2

A sheet named Criteria counts the number of used rows on the Data sheet and then copies the above formulas on the VoucherReport 2nd row the appropriate number of times to match the number of rows on the data sheet. So I would like to run the deletezerorows before copying the formulas so the count of the number of rows to copy is correct.

Here's what i've got now:

Sub Generate_VoucherRpt()
    Application.ScreenUpdating = False
    Delete_Existing
    DeleteZeroRows ("paidjurors")
    Set_Range
    Copy_Formulas
    Application.CutCopyMode = False
    Application.Goto Reference:="R1C1"
    Application.ScreenUpdating = True
End Sub

Sub Delete_Existing()
'removes existing data from Voucher Report
'prior to generating a new report.
    Sheets("VoucherReport").Select
    Application.Goto Reference:="frms"
    ActiveCell.Offset(1, 0).Select
    ActiveCell.Value = "Filler"
    FirstCell = ActiveCell.Address
    LastCell = [A65536].End(xlUp).Address
    datalist = FirstCell & ":" & LastCell
    Range(datalist).EntireRow.Delete
End Sub

Sub Set_Range()
'sets the new range, to which the formulas
'will be copied.
    numrows = Range("namecnt").Value
    Application.Goto Reference:="frms"
    ActiveCell.Offset(1, 0).Select
    FirstCell = ActiveCell.Address
    LastCell = Cells(numrows, 1).Address
    datalist = FirstCell & ":" & LastCell
    Range(datalist).Name = "namelist"
End Sub

Sub Copy_Formulas()
'copies the formulas ("frms") to the range "namelist"
    Range("frms").Copy
    Range("namelist").Select
    ActiveSheet.Paste
End Sub

Function DeleteZeroRows(ARangeName As String) As Long
Dim rWorkingRange As Range
Dim rTestRange As Range
Dim nCountDeletes As Long
Dim nFirstRow As Long
Dim nLastRow As Long
Dim nFirstCol As Integer
Dim nLastCol As Integer
Dim nRow As Long
Dim nNewLastRow As Long
  'Remember where we started
  Application.Goto Reference:="paidjurors"
  Set rWorkingRange = ActiveSheet.Range(ARangeName)
  nFirstRow = rWorkingRange.Row
  nLastRow = rWorkingRange.Rows.Count + nFirstRow - 1
  nFirstCol = rWorkingRange.Column
  nLastCol = rWorkingRange.Columns.Count + nFirstCol - 1
  'Scan rows and delete where all zero
  For nRow = nLastRow To nFirstRow Step -1
    Application.StatusBar = "Processing row " & nRow
    Set rTestRange = Range(Cells(nRow, nFirstCol), Cells(nRow, nLastCol))
    If WorksheetFunction.Sum(rTestRange) = 0 Then
      rTestRange.EntireRow.Delete
      nCountDeletes = nCountDeletes + 1
    End If
  Next nRow
  'Re-set range definition
  nNewLastRow = nLastRow - nCountDeletes
  Application.Names(ARangeName).Delete
  Application.Names.Add ARangeName, _
           Range(Cells(nFirstRow, nFirstCol), Cells(nNewLastRow, nLastCol))
  'Wrap it up
  Application.StatusBar = False
  DeleteZeroRows = nCountDeletes
  Set rTestRange = Nothing
  Set rWorkingRange = Nothing
End Function

Leslie
landrews@metrocourt.state.nm.us

There are 10 types of people in the world -
those who understand binary
and
those who don't!

 

[Zathras]

I'm going to have to work on this tonight when I have some time. If you solve it in the meantime, please post again.

 

[lespaul]

Thank you!!! I'll keep looking into it, but I'm not really a VBA person, so I don't expect much insight!!!

Leslie
landrews@metrocourt.state.nm.us

There are 10 types of people in the world -
those who understand binary
and
those who don't!

 

[Zathras]

Ok, the DeleteZeroRows doesn't delete everything (at least not for me). But if you include the header (row 1) that gets deleted since the sum is zero.

As to the rest, can you tell me what the various range definitions are? ("namecnt" "frms" "namelist" etc.)

I don't understand ...a new range named PaidJurors that is from A2 to G200... As far as I can tell, the "data" sheet uses columns A thru J and the "VoucherReport" sheet uses columns A thru F. Can you be a little more specific on the various columns and what they contain?

 

[lespaul]

Ok, I have a Delphi program that opens Vouchers.xls. It populates the "Data" sheet with:
VendorName
Address
City
JurorHours
JurorPay
Miles
MileagePay

The information is transferred via an OLE Variant Array. There is a sheet named "criteria" that counts the number of names on the "Data" sheet in order to determine how far down to copy the formula on "VoucherReport".

"VoucherReport" contains these column headers:
Vendor Name & Remittance Address
Juror Hours
Juror Pay
Miles
Mileage Pay

So once the "Data" sheet is filled in by the Delphi program, the formula from the second row in VoucherReport (under the columntitles) is copied the correct number of times (from the criteria counter) so that VoucherReport shows a formatted, user friendly report.

What I need to happen, is before the formulas are copied in VoucherReport, delete all the rows with a zero payment amount. That can be determined by checking all four columns (JurorHours, JurorPay, Miles, MileagePay) or summing it, or whatever really, as long as the rows in "data" are deleted BEFORE the formula is copied.

Does that make sense? Thanks for your help.

Les

 

[Zathras]

Ok. Based on those specs, here is all the code you need. It doesn't use any range names so you can delete all of them if you want to. It doesn't really matter.

All of the action is in one macro which uses a modified version of my zero-row deleting macro:

Option Explicit

Sub Generate_VoucherRpt()
Dim nUsedRows As Long

  ' Clear target area

  Worksheets("VoucherReport").Activate
  Worksheets("VoucherReport").Range("A3:F65536").EntireRow.Delete
  Application.ScreenUpdating = False
  Worksheets("Data").Activate

  ' Eliminate zero-value rows

  DeleteZeroRows Intersect(ActiveSheet.UsedRange, Range("A2:G65536"))

  ' Copy formulas from row 2 as far as needed

  nUsedRows = ActiveSheet.UsedRange.Rows.Count
  Worksheets("VoucherReport").Activate
  Range("A2:F2").Copy Destination:=Range("A3:A" & nUsedRows)

' Terminate

  Application.CutCopyMode = False
  Application.ScreenUpdating = True
End Sub

Function DeleteZeroRows(ARange As Range) As Long
Dim rWorkingRange As Range
Dim rTestRange As Range
Dim nCountDeletes As Long
Dim nFirstRow As Long
Dim nLastRow As Long
Dim nFirstCol As Integer
Dim nLastCol As Integer
Dim nRow As Long
Dim nNewLastRow As Long
  
  Set rWorkingRange = ARange
  nFirstRow = rWorkingRange.Row
  nLastRow = rWorkingRange.Rows.Count + nFirstRow - 1
  nFirstCol = rWorkingRange.Column
  nLastCol = rWorkingRange.Columns.Count + nFirstCol - 1

  'Scan rows and delete where all zero

  For nRow = nLastRow To nFirstRow Step -1
    Set rTestRange = Range(Cells(nRow, nFirstCol), Cells(nRow, nLastCol))
    If WorksheetFunction.Sum(rTestRange) = 0 Then
      rTestRange.EntireRow.Delete
      nCountDeletes = nCountDeletes + 1
    End If
  Next nRow

  'Wrap it up

  DeleteZeroRows = nCountDeletes
  Set rTestRange = Nothing
  Set rWorkingRange = Nothing
End Function

Sometimes we make things more complicated than we need to.

 

[lespaul]

Ok, it's still deleting all the rows, but I figured out why!! Even though the cells say

12 61.8 36 9

when you try to sum them it comes to 0 - because they are text maybe??? So when you do the sum to delete it deletes everything!

So how do I change the cells from text to numbers???

Thanks!

Les

 

[verplexd]

There are various conversion functions in VB that you can use:

CBool(expression)
CByte(expression)
CCur(expression)
CDate(expression)
CDbl(expression)
CDec(expression)
CInt(expression)
CLng(expression)
CSng(expression)
CStr(expression)
CVar(expression)

Check the VBHelp to determine which one you need (probably CLng and/or CInt).

 

[Zathras]

Numbers that are really text often cause difficulties like this. But I think we are almost there.

Make the following changes to the code:

Replace the line

  If WorksheetFunction.Sum(rTestRange) = 0 Then

with the line

  If SumText(rTestRange) = 0 Then

Then add this function at the bottom (or anywhere in the module):

Function SumText(ARange As Range) As Double
Dim c As Range
  For Each c In ARange
    If IsNumeric(c.Text) Then
      SumText = SumText + c.Text
    End If
  Next c
End Function

 

[lespaul]

So I tried recording a macro to change the cell format type, but it doesn't do anything! I select the cell I want to change, change it, but nothing is affected, the cells still have a text value and it won't add them up! If I enter the number manually, it knows it is suppose to be a number, but not the existing cell value.

Any suggestions?

Thanks,
les

 

[Zathras]

You don't have to change the data, see previous post.

 

[lespaul]

Same time posting!! That works like a charm!!! Stars for you!

Now, for the next little piece of this project. Once all the zero total rows are deleted, I would like to print the "VoucherReport" 50 lines at a time, is there a way to set the print area or break it up so that I can subtotal each 50 person VoucherReport AND print a TOTAL VoucherReport Summary?

Thanks!

Les