VBA Formula

Vishaal

Well-known Member
Joined
Mar 16, 2019
Messages
530
Office Version
  1. 2010
  2. 2007
Platform
  1. Windows
  2. Web
Hi All

Thanks in advance,

I have the following sheet

Excel 2010 32 bit
A
B
C
D
E
1
S.No.​
25689​
365478​
2569​
25698​
2
2564​
2145​
1425​
1478​
3
4
1​
25​
5​
8​
20​
5
2​
30​
10​
10​
23​
6
3​
35​
20​
12​
26​
7
4​
40​
30​
14​
29​
8
5​
45​
40​
16​
31​
9
6​
50​
50​
18​
33​
10
7​
55​
19​
36​
11
8​
60​
39​
12
9​
65​
41​
13
10​
70​
42​
14
11​
43​
15
12​
Sheet: Sheet1

and need the following result in same sheet

Excel 2010 32 bit
A
B
C
D
E
1
S.No.​
25689​
365478​
2569​
25698​
2
2564​
2145​
1425​
1478​
3
4
1​
5
2​
6
3​
Yes​
7
4​
Yes​
Yes​
8
5​
Yes​
Yes​
9
6​
Yes​
Yes​
10
7​
Yes​
Yes​
11
8​
Yes​
Yes​
12
9​
Yes​
Yes​
13
10​
Yes​
Yes​
14
11​
Yes​
15
12​
Sheet: Sheet1

We have added the "Four Yes" from bottom in every column and removed the all numbers

Pls provide the solution
 

Excel Facts

Convert text numbers to real numbers
Select a column containing text numbers. Press Alt+D E F to quickly convert text to numbers. Faster than "Convert to Number"
Means nothing to me or indeed anyone else

Please provide more info regarding the logic applied
 
Upvote 0
Let me know if this is what you are looking for.


Book1
ABCDEFGHIJK
1S.No.25689365478256925698S.No.25689365478256925698
225642145142514782564214514251478
3
412558201
52301010232
63352012263Yes
74403014294YesYes
85454016315YesYes
96505018336YesYes
1075519367YesYes
11860398YesYes
12965419YesYes
1310704210YesYes
14114311Yes
151212
Sheet1


Code:
Sub STSIW()
Dim r As Range: Set r = Range("A1:E" & Range("A" & Rows.Count).End(xlUp).Row)
Dim AR() As Variant: AR = Application.Transpose(r.Value)


For col = 2 To UBound(AR)
    For Ro = 4 To UBound(AR, 2)
        If AR(col, Ro) = "" Then
            For j = Ro - 4 To Ro - 1
                AR(col, j) = "Yes"
            Next j
            Exit For
        Else
            AR(col, Ro) = ""
        End If
    Next Ro
Next col


Range("G1").Resize(UBound(AR, 2), UBound(AR)).Value = Application.Transpose(AR)


End Sub
 
Upvote 0
or ...

BEFORE

Excel 2016 (Windows) 32 bit
A
B
C
D
E
F
G
H
I
J
K
1
S.No.
25689​
365478​
2569​
25698​
25698​
25698​
25698​
25698​
25698​
25698​
2
2564​
2145​
1425​
1478​
1478​
1478​
1478​
1478​
1478​
1478​
3
4
1​
25​
5​
8​
20​
20​
20​
20​
20​
20​
5
2​
30​
10​
10​
23​
23​
23​
23​
23​
6
3​
35​
20​
12​
26​
26​
26​
26​
7
4​
40​
30​
14​
29​
29​
8
5​
45​
40​
16​
31​
9
6​
50​
50​
18​
33​
10
7​
55​
19​
36​
11
8​
60​
39​
12
9​
65​
41​
13
10​
70​
42​
14
11​
43​
15
12​
16
17
Sheet: Sheet2

AFTER

Excel 2016 (Windows) 32 bit
A
B
C
D
E
F
G
H
I
J
K
1
S.No.
25689​
365478​
2569​
25698​
25698​
25698​
25698​
25698​
25698​
25698​
2
2564​
2145​
1425​
1478​
1478​
1478​
1478​
1478​
1478​
1478​
3
4
1​
Yes​
Yes​
Yes​
Yes​
Yes​
5
2​
Yes​
Yes​
Yes​
Yes​
6
3​
Yes​
Yes​
Yes​
Yes​
7
4​
Yes​
Yes​
Yes​
8
5​
Yes​
Yes​
9
6​
Yes​
Yes​
10
7​
Yes​
Yes​
11
8​
Yes​
Yes​
12
9​
Yes​
Yes​
13
10​
Yes​
Yes​
14
11​
Yes​
15
12​
16
17
Sheet: Sheet2

Code:
Sub Vishaal()
    Dim c As Long, lastCol As Long, r As Long
    Dim ws As Worksheet, c1 As Range, c2 As Range, c3 As Range
    Set ws = ActiveSheet
    
    lastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
    
    For c = 2 To lastCol
        r = ws.Cells(ws.Rows.Count, c).End(xlUp).Row
        Set c1 = ws.Cells(4, c)
        Set c2 = ws.Cells(r, c)
        If r > 3 Then
            Set c3 = c2.Offset(-3)
            If c3.Row < 4 Then Set c3 = c1
            ws.Range(c1, c2).ClearContents
            ws.Range(c3, c2) = "Yes"
        End If
        
        Set c1 = Nothing
        Set c2 = Nothing
        Set c3 = Nothing
        
    Next c
End Sub
 
Upvote 0
Here is another one to try

Rich (BB code):
Sub YesLast4()
  Dim c As Long, fr As Long, lr As Long
  Const FirstDataRow As Long = 4
  
  For c = 2 To 5
    lr = Cells(Rows.Count, c).End(xlUp).Row
    If lr < FirstDataRow Then Exit For
    fr = lr - 3
    If fr < FirstDataRow Then fr = FirstDataRow
    Cells(fr, c).Resize(lr - fr + 1).Value = "Yes"
    If fr > FirstDataRow Then Cells(FirstDataRow, c).Resize(fr - FirstDataRow).ClearContents
  Next c
End Sub
 
Last edited:
Upvote 0
Thanks Yongle JI,

Its working for me,

Thanks for your help
 
Upvote 0
Hi, the above vba code are working fine for the above given data but when i am adding some coloumns and row, coloumn AtoCB and rows 1to25

The above code is not working

Help pls
 
Upvote 0

Forum statistics

Threads
1,213,521
Messages
6,114,109
Members
448,548
Latest member
harryls

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