Solved: Checking contents of a cell

[BexleyManor]

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!!


[VBA]Range("D" & CStr(LSR)).Value = "DEBIT"[/VBA]

[Ken Puls]

Maybe...

[vba]If Range("D" & CStr(LSR)).Value < 1000000 Then[/vba]

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

[vba]If Abs(Range("D" & CStr(LSR)).Value) < 1000000 Then[/vba]

HTH,

[BexleyManor]

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]

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:
[vba]Range("G1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).FormulaR1C1 = "=SUM(R[-100]C:R[-1]C)"[/vba]
..But this is hard coded to do G1 to G100, tomorrow the list might be G1 to G150. How do I dynamically change the.... [vba]SUM(R[-100]C:R[-1]C)[/vba]
Thanks, again !!

[Ken Puls]

Hi Bex,

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

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

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.

[vba]'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)"[/vba]

HTH,

[BexleyManor]

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]

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:
[vba]ActiveCell.Offset(1, 0).Formula = "=Sum(G:G)"[/vba]

HTH,

[BexleyManor]

Tried the last suggestion, however I just get a 0.00 figure??

[mdmackillop]

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.

Malcolm,

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

[BexleyManor]

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

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

[mdmackillop]

How is column G being filled? Existing formulae, or values/formue written by code. Can you post your workbook?
Regards
MD

[BexleyManor]

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??

[VBA]
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."[/VBA]

[mdmackillop]

Sum line added, and I've tidied up so your code should run a bit faster
[vba]
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

[/vba]

[BexleyManor]

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]

Depending upon how many lines you're dealing with, a filter may be quicker than your loops.
HTH

[BexleyManor]

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..
[vba]If .Range("D" & LSR).Value = "DEBIT" Then
.Rows(LSR).Copy Sheets("MI").Cells(LCR, 1)[/vba]
Going forward I have another question about how to have this [vba]Range("D" & LSR).Value = "DEBIT"[/vba] perform something like [vba]Range("E" & "F" & LSR).Value = "A vairiable text and number other than the text NREF" & "A vairiable text and number > 6 digits / words"[/vba]

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]

Here's a greatly reduced & sanitized a version of wkbook, I've commented the sheet and code. If you have questions, please ask!!

[mdmackillop]

Simplest way is to "reverse" the prior statements that you used to select lines for copying.
[vba]
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

[/vba]

[mdmackillop]

Here's the filter method, which should be quicker for large spreadsheets
[vba]
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

[/vba]

[BexleyManor]

Fantasic work MD, many thanks indeed.

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

Thanks again.