VBA - adding condition to IF

L

Luke777

Board Regular
Joined
Aug 10, 2020
Messages
244
Office Version
  1. 365
Platform
  1. Windows
Hi all,

I'm using the following code on my sheet

VBA Code: 
Sub FillData4()


Dim ws1 As Worksheet

Set ws1 = Worksheets(1)

    For Each Cell In ws1.Range("C5:C148", Range("C5").End(xlToRight))
        If Cell.Value = "" Then
            Cell.Value = Cell.Offset(-1, 0).Value
        End If
    Next Cell
    
End Sub

The code looks in the range for blank cells. Where it finds a blank cell it then changes the value to match the same as the cell above.

This works perfectly for what I want with one exception. Each column contains the string "END" (could be anywhere in that column). Where "END" is found in that column, I would like it to then move on to the next column and *not* change all the blanks under "END" within the range, to "END".

Hopefully that makes sense :)

Any ideas on this one?

Thanks!
 
Sort by date Sort by votes
Luke777 said:
This certainly works, but it doesn't stop in each column where END/last entry in column is - so it seems to do exactly the same as the original code unless im missing something
Click to expand...
It should if END is truly the last entry in a column. But then I got to think, it is probably those blased "fake blanks" screwing things up.
(which actually explains why your "C5 end to the right" logic works when there are blanks in row 5).

So let's add the original end column logic back and and add an end to the loop once it hits "END", i.e.
VBA Code: 
Sub MyFillMacro2()

    Dim lc As Long
    Dim c As Long
    Dim fr As Long
    Dim lr As Long
    Dim r As Long
  
    Application.ScreenUpdating = False
  
'   Find last column with data
    lc = Range("C5").End(xlToRight).Column

'   Loop through all columns
    For c = 3 To lc
'       First first row in column with data, starting with row 5
        If Cells(5, c) <> "" Then
            fr = 5
        Else
            fr = Cells(4, c).End(xlDown).Row
        End If
'       Find last row in column with data
        lr = Cells(Rows.Count, c).End(xlUp).Row
'       Loop through each row in column
        For r = (fr + 1) To (lr - 1)
'           If cell is blank, copy value from row above
            If Cells(r, c) = "" Then
                Cells(r, c).Value = Cells(r - 1, c)
            Else
'               Check to see if at END
                If Cells(r, c) = "END" Then Exit For
            End If
        Next r
    Next c

    Application.ScreenUpdating = True

End Sub
 
Upvote 0

Excel Facts

Repeat Last Command
Pressing F4 adds dollar signs when editing a formula. When not editing, F4 repeats last command.
Joe4 said:
It should if END is truly the last entry in a column. But then I got to think, it is probably those blased "fake blanks" screwing things up.
So let's add an end to the loop once it hits "END", i.e.
VBA Code: 
Sub MyFillMacro2()

    Dim lc As Long
    Dim c As Long
    Dim fr As Long
    Dim lr As Long
    Dim r As Long
  
    Application.ScreenUpdating = False
  
'   Find last column with data
    lc = Range("C5").End(xlToRight).Column

'   Loop through all columns
    For c = 3 To lc
'       First first row in column with data, starting with row 5
        If Cells(5, c) <> "" Then
            fr = 5
        Else
            fr = Cells(4, c).End(xlDown).Row
        End If
'       Find last row in column with data
        lr = Cells(Rows.Count, c).End(xlUp).Row
'       Loop through each row in column
        For r = (fr + 1) To (lr - 1)
'           If cell is blank, copy value from row above
            If Cells(r, c) = "" Then
                Cells(r, c).Value = Cells(r - 1, c)
            Else
'               Check to see if at END
                If Cells(r, c) = "END" Then Exit For
            End If
        Next r
    Next c

    Application.ScreenUpdating = True

End Sub
Click to expand...
Works beautifully - I think it's struggling a little with my weird sheet though.

I believe it's checking from C5 to the right for data - but only in that row? So if there was no data in say Q5 but there *is* data in Q22, it won't run in that column?
 
Upvote 0
Luke777 said:
I believe it's checking from C5 to the right for data - but only in that row? So if there was no data in say Q5 but there *is* data in Q22, it won't run in that column?
Click to expand...
I thought you said that the original logic of:
VBA Code: 
Range("C5").End(xlToRight)
was working? So I just re-introduced it, as you said my method of finding the last column was NOT working.

At this point, I don't think there is much that I can do without working with your actual spreadsheet.
It just seems to have too many oddities, with the way things were done and how the data was created.
Your data samples are not really representative of the data you are working with.

If you want to upload a copy of your file and provide a link to it, at that point where you have run your other macros to get it to this point, I can take a look at it and see what the data looks like, and what my code does to it, and seeing if I can modify it to work on your data. You can even remove the macros before uploading it - I don't need those, just what the data actually looks like at the point where you want to run this code we are trying to build.
 
Upvote 0
OK, I just had a thought of another way around this. If every column with data has as "END" in it, and the first column without an "END" is where we want to stop, We can not pre-count the columns, and just keep going across until we find a column without an "END", i.e.
VBA Code: 
Sub MyFillMacro2()

    Dim c As Long
    Dim fr As Long
    Dim lr As Long
    Dim r As Long
    Dim rng As Range
  
    Application.ScreenUpdating = False

'   Set first column to 3
    c = 3

'   Loop through all columns
    Do
'       See if "END" appears in this column (if not, exit loop)
        Set rng = Range(Cells(5, c), Cells(Rows.Count, c))
        If Application.WorksheetFunction.CountIf(rng, "END") = 0 Then
            Exit Do
        End If
'       First first row in column with data, starting with row 5
        If Cells(5, c) <> "" Then
            fr = 5
        Else
            fr = Cells(4, c).End(xlDown).Row
        End If
'       Find last row in column with data
        lr = Cells(Rows.Count, c).End(xlUp).Row
'       Loop through each row in column
        For r = (fr + 1) To (lr - 1)
'           If cell is blank, copy value from row above
            If Cells(r, c) = "" Then
                Cells(r, c).Value = Cells(r - 1, c)
            Else
'               Check to see if at END
                If Cells(r, c) = "END" Then Exit For
            End If
        Next r
'       Increment column counter
        c = c + 1
    Loop

    Application.ScreenUpdating = True

End Sub
 
Upvote 0
Joe4 said:
OK, I just had a thought of another way around this. If every column with data has as "END" in it, and the first column without an "END" is where we want to stop, We can not pre-count the columns, and just keep going across until we find a column without an "END", i.e.
VBA Code: 
Sub MyFillMacro2()

    Dim c As Long
    Dim fr As Long
    Dim lr As Long
    Dim r As Long
    Dim rng As Range
 
    Application.ScreenUpdating = False

'   Set first column to 3
    c = 3

'   Loop through all columns
    Do
'       See if "END" appears in this column (if not, exit loop)
        Set rng = Range(Cells(5, c), Cells(Rows.Count, c))
        If Application.WorksheetFunction.CountIf(rng, "END") = 0 Then
            Exit Do
        End If
'       First first row in column with data, starting with row 5
        If Cells(5, c) <> "" Then
            fr = 5
        Else
            fr = Cells(4, c).End(xlDown).Row
        End If
'       Find last row in column with data
        lr = Cells(Rows.Count, c).End(xlUp).Row
'       Loop through each row in column
        For r = (fr + 1) To (lr - 1)
'           If cell is blank, copy value from row above
            If Cells(r, c) = "" Then
                Cells(r, c).Value = Cells(r - 1, c)
            Else
'               Check to see if at END
                If Cells(r, c) = "END" Then Exit For
            End If
        Next r
'       Increment column counter
        c = c + 1
    Loop

    Application.ScreenUpdating = True

End Sub
Click to expand...
Hi

Thanks for both replies, they're really really appreciated.

Below is my sheet

Rota 3.xlsm
CDEFGHIJKLM
12862141535158013071029573076932538542
2
306:30-15:0006:30-15:0006:30-16:0006:30-16:0006:30-15:0006:30-16:0006:30-15:0006:30-16:0007:30-17:3007:30-17:0007:45-16:45
44646464646532346
5121212121212
6
7
84646
9121246
1012
11Br2424
12BrBrBrBr53Br10
13Br12121212231212
1412BrBr
152312
16Br
17Br10
1812
19
20
21
22MB
23MBBr
24MB12MBMBMBMBMB12
2512
26121212532312
27
28MB
29
3012
31Br
3223MB
33BrBrBrBrBrBr
3412121212121212
35Br
3612
37BrBr
38ENDENDEND53ENDBr12
3912
40Br
4112
42ENDENDENDEND
43
44
45END
46END
47
48END
Rota


A:B have been cut off - they're not needed. Columns also continue to the right but aren't set - could be ten, could be 1420 (very unlikely). The rows also go down to 148, but this is just a sample of the sheet that should be enough to work from with any luck :)

Below is what happens when I run the op code - the repeating "END" is just unnecessary and time consuming

Rota 3.xlsm
CDEFGHIJKLM
12862141535158013071029573076932538542
2
306:30-15:0006:30-15:0006:30-16:0006:30-16:0006:30-15:0006:30-16:0006:30-15:0006:30-16:0007:30-17:3007:30-17:0007:45-16:45
44646464646532346
51212121212532312
61212121212532312
71212121212532312
812121212125323124646
91212121212532312121246
101212121212532312121212
111212121212Br2412241212
1212BrBrBrBr5324Br241012
13Br12121212532312121012
14121212121253Br121210Br
151212121212532312121012
16121212121253231212Br12
171212121212532312Br1012
181212121212532312121012
191212121212532312121012
201212121212532312121012
211212121212532312121012
221212MB1212532312121012
23MB12MB12125323121210Br
24MBMB12MBMBMBMBMB121012
2512MB12MBMBMBMBMB121012
261212121212532312121012
271212121212532312121012
28121212121253231212MB12
29121212121253231212MB12
301212121212532312121212
31121212121253Br12121212
321212121212532312MB1212
33BrBrBrBrBr5323BrMB1212
341212121212532312121212
3512121212125323121212Br
361212121212532312121212
371212121212Br231212Br12
38ENDEND1212END53END12Br1212
39ENDEND1212END53END12121212
40ENDEND1212END53END121212Br
41ENDEND1212END53END12121212
42ENDENDENDENDENDENDENDEND121212
43ENDENDENDENDENDENDENDEND121212
44ENDENDENDENDENDENDENDEND121212
45ENDENDENDENDENDENDENDEND1212END
46ENDENDENDENDENDENDENDEND12ENDEND
47ENDENDENDENDENDENDENDEND12ENDEND
48ENDENDENDENDENDENDENDENDENDENDEND
Rota


The code you have supplied fixes that issue, but doesn't work on the entire range - though that's down to my poor explanation of my requirements. The last bit of code you supplied works beautifully with that exception - but I couldn't quite work out which part to edit to adjust for my range requirements. In fairness, I've not had much time over the weekend to get stuck into it.

But again, thank you for replies and all of your help!
 
Upvote 0
Turns out a minor modification to my OP was all I needed but I didn't quite understand that at the time of asking.

The below code does exactly what I want it to do though I appreciate there is most likely a faster way of doing this (macro completion time not code length) as I believe this method needlessly checks blank cells where it doesn't need to.

VBA Code: 
Sub Fill() 

Dim ws1 As Worksheet

Set ws1 = Worksheets(1)

    For Each Cell In ws1.Range("C5:C148", Range("C5").End(xlToRight))
        If Cell.Value = "" And Cell.Offset(-1, 0).Value <> "END" Then
            Cell.Value = Cell.Offset(-1, 0).Value
        End If
    Next Cell
End Sub
 
Upvote 0
I am glad you got something figured out. There may be other ways of doing it, but without having access to your actual worksheets, it is very hard to come up with something (as we saw from our many attempts). You have so many "faux blanks" that were created by formulas and then Copy -> Paste Special -> Values. Without seeing exactly where all those are, it is just a guessing game.

There are two minor things you can do to improve your current code:

1. Do NOT use reserved words (that is, words that are already used as functions, methods, objects, etc) like "Fill" as the name of your variables, procedures, or user defined functions. This can lead to errors and unexpected behavior (i.e. if you use "Fill" in your code, Excel doesn't know if you mean the "Fill" method or your "Fill" procedure). I often preface my variables and procedure with the word "My" to make sure I avoid those conflicts, i.e. "Sub MyFill().

2. You can speed up your code by suppressing screen updating until the end of the code, i.e.

VBA Code: 
Sub MyFill()

Dim ws1 As Worksheet

Application.ScreenUpdating = False

Set ws1 = Worksheets(1)

    For Each Cell In ws1.Range("C5:C148", Range("C5").End(xlToRight))
        If Cell.Value = "" And Cell.Offset(-1, 0).Value <> "END" Then
            Cell.Value = Cell.Offset(-1, 0).Value
        End If
    Next Cell
    
Application.ScreenUpdating = True

End Sub

To be honest with you, if your code does what you want, and is fairly quick, I wouldn't waste too much time trying to perfect it to save a few seconds.
I am a firm believer that "good enough and on-time" is better than "perfect, but late".
 
Upvote 0
Solution
Joe4 said:
I am glad you got something figured out. There may be other ways of doing it, but without having access to your actual worksheets, it is very hard to come up with something (as we saw from our many attempts). You have so many "faux blanks" that were created by formulas and then Copy -> Paste Special -> Values. Without seeing exactly where all those are, it is just a guessing game.

There are two minor things you can do to improve your current code:

1. Do NOT use reserved words (that is, words that are already used as functions, methods, objects, etc) like "Fill" as the name of your variables, procedures, or user defined functions. This can lead to errors and unexpected behavior (i.e. if you use "Fill" in your code, Excel doesn't know if you mean the "Fill" method or your "Fill" procedure). I often preface my variables and procedure with the word "My" to make sure I avoid those conflicts, i.e. "Sub MyFill().

2. You can speed up your code by suppressing screen updating until the end of the code, i.e.

VBA Code: 
Sub MyFill()

Dim ws1 As Worksheet

Application.ScreenUpdating = False

Set ws1 = Worksheets(1)

    For Each Cell In ws1.Range("C5:C148", Range("C5").End(xlToRight))
        If Cell.Value = "" And Cell.Offset(-1, 0).Value <> "END" Then
            Cell.Value = Cell.Offset(-1, 0).Value
        End If
    Next Cell
   
Application.ScreenUpdating = True

End Sub

To be honest with you, if your code does what you want, and is fairly quick, I wouldn't waste too much time trying to perfect it to save a few seconds.
I am a firm believer that "good enough and on-time" is better than "perfect, but late".
Click to expand...
Thanks for all the help Joe4 and thank you for the advice!

I've marked that last post of yours as best answer - its worth that for the last two lines of advice alone :)
 
Upvote 0
You must log in or register to reply here.

Similar threads

B
  • Question
Matching Multiple Header Row Cell Values - Copy the data below to next available row.
Replies
1
Views
202
bobaol
B
J
  • Solved
VBA to compare rows in two different sheets, if match highlight cell
2
Replies
10
Views
609
kevin9999
K
T
  • Question
Testing the date in a table - can't do it row by row?
Replies
2
Views
103
Anthony47
A
A
  • Question
runtime error 6 overflow, macro to create table
Replies
8
Views
302
atditiljazi
A
P
  • Question
Code used for comparison between 2 list.
Replies
3
Views
306
Tupe77
T

Forum statistics

Threads
1,214,786
Messages
6,121,548
Members
449,038
Latest member
Guest1337

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top