Pass one step of code to the next

[julhs]

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

' #### 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															694.50
11	s	Apr-07		D. Debit	Amazon Prime	5.99		5.99
12	s	Apr-07	gs005	My Sol	Heating Oil	540.22															540.22
13	s	Apr-08		D. Debit	EE Mobile(1)	28.21											28.21
14	s	Apr-08		D. Debit	AA membership	39.61					39.61
15	s	Apr-11	gs010	My Sol	Fuel Other	127.00						127.00
16	s	Apr-12	gs015	My Sol	Tesco	29.44		29.44
17	s	Apr-12	gs020	My Sol	Tesco	113.55		113.55
18	s	Apr-13	gs023	My Sol	Amazon Prime	2.99		2.99
19	s	Apr-19		D. Debit	EDF energy	16.25															16.25
20	s	Apr-19	gs025	My Sol	Tesco	15.00		15.00
21	s	Apr-13	gs030	My Sol	Amazon Prime	5.99		5.99
22	s	Apr-19		D. Debit	EDF energy	21.00															16.25					A4 Used Range is:-
23	s
24	s					1639.75	Cash Paid	172.96			39.61	127.00					28.21				1267.22
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]

Hi julhs,

instead of

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

use

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

Holger

 

[julhs]

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]

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.

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

maybe written as

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

or

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]

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]

Also the

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]

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

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

 “On Error GoTo 0”

Tested changing it to

 “On Error GoTo 0”

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

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]

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

 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]

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

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

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

 

[julhs]

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?