Pass one step of code to the next

julhs · Feb 2, 2023

As I had no replies to my initial thread and have made so many alterations/additions to it; I have decided that it’s better to start a new one and include a Xl2bb
Linked to other thread
Combining 2 separate codes into one

The ultimate problem is failure to pass; “ UsedRng = Range("s" & firstRow & ":s" & lastRow).Address” '= "$s$10:$S$22" to the next step of the code.
Please bear in mind that code I’ve posted is my ham-fisted way to test returned results/outcomes, a lot of which will be removed/ rationalised in my final draft.

This is the section of code where I have not got things right!!

UsedRng = Range("s" & firstRow & ":s" & lastRow).Address '= "$s$10:$S$22"
'End With 'temp subbed out, not sure if should be here or at the very bottom
'#########################################################
'?????????????????????????????????????????????????????
' This is where I'm failing to pass the "ACTUAL USED RANGE" ("$S$10:$S$22") from the above section to
If UsedRng Is Nothing Then Exit Sub
If copyCells Is Nothing Then Exit Sub

For Each r In rng
r.Interior.Color = r.DisplayFormat.Interior.Color ' This converts the Conditional Formatting effect to a "Fixed" static color formatt
Next r
rng.FormatConditions.Delete 'This deletes the CF rule from the range just converted to "Fixed" colors before it copies it
'---------------------------------------------------
Set rng = sht.Range("t:t").Find(what:="Cash Paid", LookIn:=xlValues, LookAt:=xlWhole)
Lrow = sht.Cells(sht.Rows.Count, "T").End(xlUp).Row
Lrow = rng.Row
DestRow = sht.Range("T:T").Find(what:="Cash Paid", LookIn:=xlValues, LookAt:=xlWhole).Row 'Locates LAST row of Input Section to paste copied cells to
For i = 9 To Lrow ' Is the start row to copy FROM
Set rng = sht.Range("S" & firstRow & i & ":S" & lastRow & i) ' Col that looking for "Comments" in
If Not rng.Comment Is Nothing Then
'?????????????????????????????????????????????????????
'#########################################################
Code then continues …..

Complete code and Xl2bb

VBA Code:

' #### Some of the DIM's below may NOW be redundant
Public Sub juhls4_plus2Combined_A4()
Dim sht As Worksheet
Dim lastcell As Range, firstcell As Range
Dim lastRow As Long, firstRow As Long
Dim findString As String
Dim LstUsedRow As Variant
Dim FstUsedCell  As Variant

Dim Lrow As Long, DestRow As Long, i As Integer
Dim Frow As Long
Dim rng As Range, r As Range
Dim LrwD As Long
Dim CFcell As Range
Dim copyCells As Range
Dim Usedcells As Long
Dim UsedRng As Range    ' use for "ACTUAL USED RANGE" of Col S found
Dim ClearRng As Range   ' use for " WorksheetFunction.CountA( "
          
       ' Application.ScreenUpdating = False  ' re-apply when testing complete
    Set sht = ThisWorkbook.ActiveSheet
'----------------------------------------------------------
                   ' Test "S7" for CF rules
    Set CFcell = sht.Range("S7")  'cell with CF rules for copying
      If CFcell.FormatConditions.Count = 0 Then
         MsgBox CFcell.Address & "  NO CF rules in Cell"
          ' Exit Sub   ~~~~~~~  Maybe add code to copy CF rules FROM S6 INTO S7 and then continue ??
        Else
         MsgBox CFcell.Address & "  Cell contains CF rules"
      End If
'----------------------------------------------------------
        Frow = sht.Range("T:T").Find(what:="Cash Paid", LookIn:=xlValues, LookAt:=xlWhole).Row
        LrwD = sht.Cells(sht.Rows.Count, "AN").End(xlUp).Row
        
   Set ClearRng = sht.Range("AL" & Frow + 1 & ":AN" & LrwD + 1)
       If WorksheetFunction.CountA(ClearRng) = 0 Then
         MsgBox "  Range Is Empty"
        GoTo line1:
      Else
        MsgBox "  Range NOT Empty"
   End If
'-----------------------------------------------------
            ' This is to clear the Destination range before a new paste,it first_
            '   finds the row beneath target row with "Cash Paid" in column T
        Frow = sht.Range("T:T").Find(what:="Cash Paid", LookIn:=xlValues, LookAt:=xlWhole).Row
         LrwD = sht.Cells(sht.Rows.Count, "AN").End(xlUp).Row
         sht.Range("AL" & Frow + 1 & ":AN" & LrwD + 1).Clear
line1:  On Error Resume Next   ' Is line code goes to if "ClearRng" ("AL25:AN30") is "EMPTY/BLANK"
'---------------------------------------------------
        ' This section returns the "ACTUAL USED RANGE" of column S ("S10:s22")-(Curtesy of Alex Blakenburg)
     With sht
             ' Get start of Data Range
          findString = "Bank & Cash"
     Set firstcell = .Range("S:S").Find(what:=findString, LookIn:=xlValues, LookAt:=xlWhole)
        If firstcell Is Nothing Then Exit Sub
       
          firstRow = firstcell.End(xlDown).Row
       
             ' Get end of Data Range
         findString = "Cash Paid"
           Set lastcell = .Range("T:T").Find(what:=findString, LookIn:=xlValues, LookAt:=xlWhole)
        If lastcell Is Nothing Then Exit Sub
       
     Set lastcell = lastcell.Offset(, -1)        ' Move across to amount column
        If lastcell.Offset(-1) <> "" Then
            Set lastcell = lastcell.Offset(-1)
        Else
            Set lastcell = lastcell.End(xlUp)
       End If
        lastRow = lastcell.Row
    
    Range("AM24") = Range("s" & firstRow & ":s" & lastRow).Address  ' Puts ACTUAL USED RANGE" into a cell on sheet
    UsedRng = Range("s" & firstRow & ":s" & lastRow).Address  '= "$s$10:$S$22"
        ' End With   ' temp subed out, not sure if should be here or at the very bottom

'#########################################################
'?????????????????????????????????????????????????????
       '  This is where I'm failing to pass the "ACTUAL USED RANGE" ("$S$10:$S$22") from the above section to
   If UsedRng Is Nothing Then Exit Sub
   If copyCells Is Nothing Then Exit Sub ' this needs to be changed to..... ??

    For Each r In rng
        r.Interior.Color = r.DisplayFormat.Interior.Color ' This converts the Conditional Formatting effect to a "Fixed" static color formatt
    Next r
        rng.FormatConditions.Delete    ' This deletes the CF rule from the range just converted to "Fixed" colors before range is copied
 '---------------------------------------------------
 
   Set rng = sht.Range("t:t").Find(what:="Cash Paid", LookIn:=xlValues, LookAt:=xlWhole)
        Lrow = sht.Cells(sht.Rows.Count, "T").End(xlUp).Row
        Lrow = rng.Row
                
        DestRow = sht.Range("T:T").Find(what:="Cash Paid", LookIn:=xlValues, LookAt:=xlWhole).Row ' Locates LAST row of Input Section to paste copied cells to
      For i = 9 To Lrow                                        ' Is the start row to copy FROM
      Set rng = sht.Range("S" & firstRow & i & ":S" & lastRow & i) ' Col that looking for "Comments" in
    If Not rng.Comment Is Nothing Then
'?????????????????????????????????????????????????????
'#########################################################

        sht.Range("P" & i).Copy                             ' Corresponding Inv#
        sht.Range("AL" & DestRow + 1).PasteSpecial xlPasteAll
        sht.Range("R" & i & ":S" & i).Copy     ' Payment details List & Bank Col
        sht.Range("AM" & DestRow + 1 & ":AN" & DestRow + 1).PasteSpecial xlPasteAll ' Destination for copied cell
    
          DestRow = DestRow + 1
     End If
       Next
        copyCells.Copy  ' This needs to relate UsedRng "$S$10:$S$22", maybe "UsedRng.Copy"
            pasteRng.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
                SkipBlanks:=False, Transpose:=False
  
  sht.Range("Am" & Frow).Select  ' Makes cell at top of Destination range ("AM24")the active cell
            'Application.CutCopyMode = False  ' Dont need this as is for when using InputBoxes
        ' Application.ScreenUpdating = True    ' re-apply when testing complete
        
   End With   ' not sure if should be here or at end of "ACTUAL USED RANGE" section
'======================================================
        ' For testing purposes
    Debug.Print "UsedRng: " & Range("S" & firstRow & ":S" & lastRow).Address 'this gives $S$10:$S$22
    Debug.Print "UsedRng: " & Range("S" & firstRow & i & ":S" & lastRow & i)
    Debug.Print UsedRng
    Debug.Print "ClearRng: " & Range("AL" & Frow + 1 & ":AN" & LrwD).Address 'this gives  $AL$25:$AN$30
    Debug.Print "rng: " & Range("S" & firstRow & ":S" & lastRow).Address    'this gives rng: $S$10:$S$22
    Debug.Print copyCells.Copy
    Debug.Print CFcell.Copy
    Debug.Print "CFcell: " & CFcell.Address
    Debug.Print Range("s" & firstRow & ":s" & lastRow).Address
    Debug.Print firstcell.Address
    Debug.Print lastcell
    Debug.Print lastcell.Address
     
  End Sub

Accounts Code TestingBook1.xlsm

N

O

P

Q

R

S

T

U

V

W

X

Y

Z

AA

AB

AC

AD

AE

AF

AG

AH

AI

AJ

AK

AL

AM

AN

AO

4

5

6

Date

Inv #

Payment Method

Payment Details List

Bank & Cash

Drawings

Purchases of Stock / Materials

Tool,Weather/Safety equip

Repairs & Renewals

Motor Expenses

Hire Charges

Liability Insurance

N.I cont / TGWU

Gen Insur Office Postage/ Stationary

Misc

Acquisition of Assets

Let Property

Bank Charges

Utilities / House

Income Tax

7

s

Leave these 2 row empty

8

s

9

s

10

s

Apr-07

gs002

St Order

Rent

694.50

11

s

Apr-07

D. Debit

Amazon Prime

5.99

12

s

Apr-07

gs005

My Sol

Heating Oil

540.22

13

s

Apr-08

D. Debit

EE Mobile(1)

28.21

14

s

Apr-08

D. Debit

AA membership

39.61

15

s

Apr-11

gs010

My Sol

Fuel Other

127.00

16

s

Apr-12

gs015

My Sol

Tesco

29.44

17

s

Apr-12

gs020

My Sol

Tesco

113.55

18

s

Apr-13

gs023

My Sol

Amazon Prime

2.99

19

s

Apr-19

D. Debit

EDF energy

16.25

20

s

Apr-19

gs025

My Sol

Tesco

15.00

21

s

Apr-13

gs030

My Sol

Amazon Prime

5.99

22

s

Apr-19

D. Debit

EDF energy

21.00

16.25

A4 Used Range is:-

23

s

24

s

Cash Paid

25

s

gs002

Rent

694.50

26

s

There is data in this area but NOT relevant

EE Mobile(1)

28.21

27

s

Fuel Other

127.00

28

s

This is just for convenience, used for copying/pasting back into AL25:AN30 during testing

gs010

EDF energy

16.25

29

s

Amazon Prime

5.99

30

A4 Used Range is:-

gs030

EDF energy

21.00

31

32

$S$10:$S$22

33

34

gs002

Rent

694.50

35

EE Mobile(1)

28.21

36

Fuel Other

127.00

37

gs010

EDF energy

16.25

38

Amazon Prime

5.99

39

gs030

EDF energy

21.00

40

41

April 22 - 23 (minimal)

Cell Formulas
Range	Formula
S24,U24:AI24	S24	=SUM(S$7:OFFSET(S24,-1,0))
AJ24	AJ24	=SUM(AJ$7:OFFSET(AI24,-1,0))
T25	T25	=SUMIF(Q$7:$Q23,$T24,$S$7:$S23)

Cells with Conditional Formatting
Cell	Condition		Cell Format	Stop If True
S7	Expression	=$Q7="My Sol"	text	YES
S7	Expression	=$Q7="D. Debit"	text	YES
S7	Expression	=$Q7="St Order"	text	YES
S6	Expression	=$Q6="My Sol"	text	YES
S6	Expression	=$Q6="D. Debit"	text	YES
S6	Expression	=$Q6="St Order"	text	YES
S10:S22	Expression	=$Q10="My Sol"	text	YES
S10:S22	Expression	=$Q10="D. Debit"	text	YES
S10:S22	Expression	=$Q10="St Order"	text	YES
S23	Expression	=$Q23="My Sol"	text	YES
S23	Expression	=$Q23="D. Debit"	text	YES
S23	Expression	=$Q23="St Order"	text	YES

HaHoBe · Feb 2, 2023

Hi julhs,

instead of

VBA Code:

    UsedRng = Range("s" & firstRow & ":s" & lastRow).Address  '= "$s$10:$S$22"

use

VBA Code:

    Set UsedRng = .Range("s" & firstRow & ":s" & lastRow).Address  '= "$s$10:$S$22"

Holger

julhs · Feb 2, 2023

Thanks HaHoBe
Changed that, had to leave off " .Address" as it caused a compile error, Type mismatch but still nothing copied & pasted
Realising problem lies with the " copyCells" referencing

HaHoBe · Feb 2, 2023

Hi julhs,

sorry about the faulty sample code.

Realising problem lies with the " copyCells" referencing

No, pasteRng hasn't been set before and isn't dimmed. You should make good use of adding Option Explicit at the top of the procedure (will be a pain at the beginning because you will need to dim all variables used but this avoids introducing variables without any value or misspelled variables). And I would advise to use prefixes to the variables to determine what type these variables are.

VBA Code:

Dim lastcell As Range, firstcell As Range
Dim lastRow As Long, firstRow As Long

maybe written as

VBA Code:

Dim rngLCell As Range
Dim rngFCell As Range
Dim lngLRow As Long
Dim lngFRow As Long

or

VBA Code:

Dim rLCell As Range
Dim rFCell As Range
Dim lLRow As Long
Dim lFRow As Long

I personally prefer the first version as generally there are problems distinguishing between one (1) and small L (l) in the VBE with Courier New as font. And I like a structured layout of code with proper indention to make it easy to recognize which lines are belonging to which segment (With...End With, For...Next, IF...End If)

Holger

julhs · Feb 2, 2023

As I often plagiarise my existing codes in the creation of a new ones, it can be fraught with problems and this is another case in point!!
Believe there is a few other similar things I need address/change etc, I’m working on that at moment.
Your point about Option Explicit and use of prefixes, duly noted!!

MARK858 · Feb 2, 2023

Also the

VBA Code:

On Error Resume Next

that you have won't help you with your testing. It should be put to 0 immediately after the error you were expecting has passed

julhs · Feb 2, 2023

Sorry Mark, struggling to follow!!
Are you referring to,

Excel Formula:

line1: On Error Resume Next

If so, that is there just to handle/skip the “Clearing” step if the destination range is already “Clear/Blank”
Do you mean substituting it for

Excel Formula:

 “On Error GoTo 0”

Tested changing it to

Excel Formula:

 “On Error GoTo 0”

Code bugs out on another line with Run time 91 error
But with it being

Excel Formula:

line1: On Error Resume Next

Code at least does not bug out and moves on.
The problem is code is not doing the later specific step of copy/pasting to the range

MARK858 · Feb 2, 2023

An On Error Resume Next should only be used to cater for a specific error that is expected and then ended with an On Error Goto 0, not left open so any unexpected errors are there.

If your On Error Resume Next wasn't still applying you would have seen that your

VBA Code:

 If UsedRng Is Nothing Then Exit Sub

would have erred because UsedRng was a string.

In general you fix errors in code not ignore them with On Error Resume Next

julhs · Feb 2, 2023

HaHoBe
I’m foundering like a fish out of water with this, I MUST STILL be setting things incorrectly or something !!
I have added Dim pasteRng As Range
Could you cast your eye over the rest of it and give me your guidance

VBA Code:

Set UsedRng = sht.Range("s" & firstRow & ":s" & lastRow)
Set CFcell = sht.Range("s7")
Set copyCells = UsedRng '= "$s$10:$S$22"
Set pasteRng = UsedRng
'--------------------------------------------
         'If copyCells Is Nothing Then Exit Sub
          'If UsedRng Is Nothing Then Exit Sub
'----------------------------------
         'if CF rules S7 is blank
         'If CFcell Is Nothing Then Exit Sub
'-------------------------------------------
         'If rng Is Nothing Then Exit Sub
         'On Error GoTo 0
'--------------------------------------------
For Each r In rng
r.Interior.Color = r.DisplayFormat.Interior.Color
Next r
rng.FormatConditions.Delete 'This deletes the CF rule from the range just converted to "Fixed" colors
'---------------------------------------------------
Set rng = sht.Range("t:t").Find(what:="Cash Paid", LookIn:=xlValues, LookAt:=xlWhole)
Lrow = sht.Cells(sht.Rows.Count, "T").End(xlUp).Row
Lrow = rng.Row

DestRow = sht.Range("T:T").Find(what:="Cash Paid", LookIn:=xlValues, LookAt:=xlWhole).Row 'Locates LAST row of Input Section to paste copied cells to

For i = 9 To Lrow ' Is the start row to copy FROM
Set rng = sht.Range("S" & firstRow & i & ":S" & lastRow & i) ' Col# that looking for "Comments" in
If Not rng.Comment Is Nothing Then
'????????????????????????????????????????????

Or the problem is in bottom few lines:-

Excel Formula:

Next
copyCells.Copy
CFcell.Copy
pasteRng.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

julhs · Feb 2, 2023

Mark
Think I VAGUELY following what you’re saying?
So in my case I was simply testing if a range IS or IS NOT “Blank/Empty”
If it was “Blank/Empty”, code should skip to line1: (avoiding the “Clearing” step)
So what should I use instead of “On Error Resume Next” in this situation?
On the basics that using "On Error GoTo 0" instead, just bugs out on a later line?

Pass one step of code to the next

julhs

Active Member

Excel Facts

HaHoBe

Well-known Member

julhs

Active Member

HaHoBe

Well-known Member

julhs

Active Member

MARK858

MrExcel MVP

julhs

Active Member

MARK858

MrExcel MVP

julhs

Active Member

julhs

Active Member

Similar threads

Forum statistics

Share this page

Pass one step of code to the next

Active Member

Excel Facts

Well-known Member

Active Member

Well-known Member

Active Member

MrExcel MVP

Active Member

MrExcel MVP

Active Member

Active Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock