PDA

View Full Version : Solved: Checking contents of a cell



BexleyManor
11-23-2006, 06:59 PM
I'm sure this is simple enough but my head is toast at near 2am UK time.

My line of code checks the cell for the value DEBIT, obviously.

But what if I want to check the cell to see if it holds any combination of numbers with 6 or less digits??

Rattling my head, I just can't think??!!! Please kind folks, stop me turning to the bottle!!


Range("D" & CStr(LSR)).Value = "DEBIT"

Ken Puls
11-23-2006, 11:37 PM
Maybe...

If Range("D" & CStr(LSR)).Value < 1000000 Then

This should return true if the value is 999999 or less, which is any combination of 6 positive digits. If you need to deal with negatives as well, then I'd probably go with

If Abs(Range("D" & CStr(LSR)).Value) < 1000000 Then

HTH,

BexleyManor
11-24-2006, 08:52 AM
I feel quite embarrassed I didn't think of that!!

Thank you kindly Ken for enlightening me, truly grateful.

Must wear dunce hat for a week now!!!!

BexleyManor
11-24-2006, 09:25 AM
Oh, And while I'm feeling stupid, how would I add a sum function to the end of a column that changes in length each day.

My current code is as follows:
Range("G1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).FormulaR1C1 = "=SUM(R[-100]C:R[-1]C)"
..But this is hard coded to do G1 to G100, tomorrow the list might be G1 to G150. How do I dynamically change the.... SUM(R[-100]C:R[-1]C)
Thanks, again !!

Ken Puls
11-24-2006, 03:04 PM
Hi Bex,

A couple of options. So long as G1 never changes, you could use:

ActiveCell.Offset(1, 0).Formula = "=Sum(G1:G" & _
Cells(Rows.Count, 7).End(xlUp).Row & ")"

I'm not sure quite what you're trying to do here. For some of my forms where I want to keep running totals with history, I'll use a named range to cover a certain area, copy and paste the values for posterity, then add the formula to the next cell to pull in the expanded data.

'Update the name
ActiveWorkbook.Names.Add Name:="rngWhatever", RefersToR1C1:= _
"=Sheet1!R1C7:R" & Cells(Rows.Count, 7).End(xlUp).Row & "C7"

'Update the formula
ActiveCell.Offset(1, 0).Formula = "=Sum(rngWhatever)"

HTH,

BexleyManor
11-24-2006, 04:00 PM
Ok, What I'm tring to do is automatically add a sum total to the end of column G1. That column of data changes daily, so it could be G1 to G100, or G1 to G500. Does that make sense?

Ken Puls
11-24-2006, 04:25 PM
Sure. Use the first of the alternatives I gave you above.

You could, of course, just sum the entire column by formula and never have to worry about updating it...

=Sum(G:G)

Or, in VBA:
ActiveCell.Offset(1, 0).Formula = "=Sum(G:G)"

HTH,

BexleyManor
11-24-2006, 05:59 PM
Tried the last suggestion, however I just get a 0.00 figure??

mdmackillop
11-24-2006, 06:21 PM
For some of my forms where I want to keep running totals with history, I'll use a named range to cover a certain area, copy and paste the values for posterity, then add the formula to the next cell to pull in the expanded data.:bug:

Malcolm,

I take it that you didn't follow my ramblings there?

BexleyManor
11-25-2006, 04:58 AM
Hi MD, could you expand a little on your suggestion please??

Are you suggesting there is a way using a named range??

Thanks !!

I just tried the following where PIS_Total is the named range for G:G, but this causes a circular reference and a 0.00 total


Range("G1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Formula = "=Sum(PIS_Total)"

mdmackillop
11-25-2006, 05:31 AM
How is column G being filled? Existing formulae, or values/formue written by code. Can you post your workbook?
Regards
MD

BexleyManor
11-25-2006, 06:04 AM
Column G gets filled with currency values every day.

Basically, My code extracts cetain data from one sheet then pastes it into a new sheet. Once the pasting has been done I want to add a SUM total to the end of column G which is populated with currency values!

Hope this helps??

I'd post the workbook but it would need a hell of a lot of sanatizing as its banking stuff.. Here's the code I use to transfer the data to the new sheet, if it helps??


Dim SR As Long, CR As Long
Sheets(1).Select
SR = 4
CR = 1

While Len(Range("A" & CStr(SR)).Value) > 0
If Range("F" & CStr(SR)).Value <= 1000000 Then
Rows(CStr(SR) & ":" & CStr(SR)).Select
Selection.Copy
Sheets("PI").Select
Rows(CStr(CR) & ":" & CStr(CR)).Select
ActiveSheet.Paste
CR = CR + 1
Sheets("Sheet1").Select
End If
SR = SR + 1
Wend
Application.CutCopyMode = False
Sheets("PI").Select
Columns("A:G").EntireColumn.AutoFit 'Column G is the one I wish to ad the SUM total to.
Cells.EntireRow.AutoFit
Columns("I:I").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.EntireColumn.Hidden = True
MsgBox "All data copied to new sheets.", vbInformation, "Acc. Sort"
Sheets(1).Select
Exit Sub
Err_Execute:
MsgBox "An error has occurred."

mdmackillop
11-25-2006, 07:09 AM
Sum line added, and I've tidied up so your code should run a bit faster

Option Explicit
Sub Bank()
Dim SR As Long, CR As Long
SR = 4
CR = 1
With Sheets(1)
While Len(.Range("A" & SR)) > 0
If .Range("F" & SR).Value <= 1000000 Then
.Rows(SR).Copy Sheets("PI").Cells(CR, 1)
CR = CR + 1
End If
SR = SR + 1
Wend
End With
Application.CutCopyMode = False
With Sheets("PI")
'Add formula to bottom of column G
.Cells(Rows.Count, 7).End(xlUp).Offset(1).FormulaR1C1 = "=SUM(R1C:R[-1]C)"
.Columns("A:G").EntireColumn.AutoFit
.Cells.EntireRow.AutoFit
.Columns("I:I").End(xlToRight).EntireColumn.Hidden = True
End With
MsgBox "All data copied to new sheets.", vbInformation, "Acc. Sort"
Exit Sub
Err_Execute:
MsgBox "An error has occurred."
End Sub

BexleyManor
11-25-2006, 07:48 AM
MD, that is just what I was looking for, brilliant work.

And many thanks for tidying up the tatty code too!!

I may come back to this post as I have something else buzzing round my head relating to it, but I'll ponder a while more to see if I can't resolve it myself!!

mdmackillop
11-25-2006, 07:53 AM
Depending upon how many lines you're dealing with, a filter may be quicker than your loops.
HTH

BexleyManor
11-25-2006, 08:44 AM
Interesting! When you say filter, do you mean using an autofilter??

My only concern is my users are not much evolved from monekys so effectively the less interaction they have, and the more automation, the better!!

One point I should make is I also have a procedure that does the same data copy but works with..
If .Range("D" & LSR).Value = "DEBIT" Then
.Rows(LSR).Copy Sheets("MI").Cells(LCR, 1)
Going forward I have another question about how to have this Range("D" & LSR).Value = "DEBIT" perform something like Range("E" & "F" & LSR).Value = "A vairiable text and number other than the text NREF" & "A vairiable text and number > 6 digits / words"

Obviously the code above is nonsensical but It's to try and show what I would lke the code to do. If that makes sense??
I've created a monster now!! ha ha ha

I would say once the data is extracted to the new sheet it's rarely more than 500 rows, Most days 100-200.

BexleyManor
11-25-2006, 09:31 AM
Here's a greatly reduced & sanitized a version of wkbook, I've commented the sheet and code. If you have questions, please ask!!

mdmackillop
11-26-2006, 04:08 AM
Simplest way is to "reverse" the prior statements that you used to select lines for copying.

Sub Bip()
Dim LSR As Long, LCR As Long
'On Error GoTo Err_Execute
LSR = 4
LCR = 1
With Sheets(1)
While Len(.Range("A" & LSR)) > 0
If .Range("D" & LSR).Value <> "DEBIT" Then
If .Range("F" & LSR).Value > 1000000 Or Not IsNumeric(.Range("F" & LSR).Value) Then
.Rows(LSR).Copy Sheets("Bi").Cells(LCR, 1)
LCR = LCR + 1
End If
End If
LSR = LSR + 1
Wend
End With
Application.CutCopyMode = False
With Sheets("Bi")
.Cells(Rows.Count, 7).End(xlUp).Offset(1).FormulaR1C1 = "=SUM(R1C:R[-1]C)"
.Cells(Rows.Count, 7).End(xlUp).Font.Bold = True
.Cells(Rows.Count, 6).End(xlUp).Offset(1).FormulaR1C1 = "=Count(R1C:R[-1]C)"
.Cells(Rows.Count, 6).End(xlUp).Font.Bold = True
.Cells.EntireRow.AutoFit
.Columns("A:G").EntireColumn.AutoFit
.Columns("I:I").End(xlToRight).EntireColumn.Hidden = True
End With
Sheets(1).Select
MsgBox "All data copied to new sheets.", vbInformation, "Account 1."
Exit Sub
'Err_Execute:
MsgBox "An error has occurred."
End Sub

mdmackillop
11-26-2006, 04:54 AM
Here's the filter method, which should be quicker for large spreadsheets

Option Explicit

Sub Macro1()
Dim LRw As Long, Rng As Range
Application.ScreenUpdating = False

LRw = Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row
Set Rng = Sheets(1).Range("A3:G" & LRw)

'DEBIT
Rng.AutoFilter Field:=4, Criteria1:="DEBIT"
Rng.SpecialCells(xlCellTypeVisible).Copy Sheets("Mi").Range("A1")
Rng.AutoFilter
AddSums "Mi"

'CREDIT
Rng.AutoFilter Field:=4, Criteria1:="CREDIT"
Rng.AutoFilter Field:=6, Criteria1:="<1000000"
Rng.SpecialCells(xlCellTypeVisible).Copy Sheets("Pi").Range("A1")
Rng.AutoFilter
AddSums "Pi"

'OTHER
'copy all CREDIT rows
Rng.AutoFilter Field:=4, Criteria1:="CREDIT"
Rng.SpecialCells(xlCellTypeVisible).Copy Sheets("Bi").Range("A1")
Rng.AutoFilter
'delete rows previously copied to Pi
LRw = Sheets("Bi").Cells(Rows.Count, 1).End(xlUp).Row
Set Rng = Sheets("Bi").Range("A1:G" & LRw)
Rng.AutoFilter Field:=6, Criteria1:="<1000000"
Application.DisplayAlerts = False
Rng.Rows("2:" & LRw).SpecialCells(xlCellTypeVisible).Delete
Application.DisplayAlerts = True
Rng.AutoFilter
AddSums "Bi"

Application.ScreenUpdating = True
End Sub

Sub AddSums(sh As String)
With Sheets(sh)
.Cells(Rows.Count, 7).End(xlUp).Offset(1).FormulaR1C1 = "=SUM(R1C:R[-1]C)"
.Cells(Rows.Count, 7).End(xlUp).Font.Bold = True
.Cells(Rows.Count, 6).End(xlUp).Offset(1).FormulaR1C1 = "=Count(R1C:R[-1]C)"
.Cells(Rows.Count, 6).End(xlUp).Font.Bold = True
.Cells.EntireRow.AutoFit
.Columns("A:G").EntireColumn.AutoFit
End With
End Sub

BexleyManor
11-26-2006, 05:38 AM
Fantasic work MD, many thanks indeed.

Two elegant solutions, I'm spoilt for choice!!

Thanks again.

Ken Puls
11-28-2006, 10:54 AM
Malcolm, thanks for picking this up for me. I've been under snow (http://excelguru.ca/blog/2006/11/26/first-snowfall-of-the-winter/) for the last couple of days...

mdmackillop
11-28-2006, 11:14 AM
HTH
Thankfully we've a very sheltered area here, so snow is occasional and rarely very deep.