Autofill series based on values in a column using Macro

[boolok2011]

I would like to use macro to autofill series in column B and autofill in column C based on the following conditions:

if the row in column A has a value 3 or 4 or 5, then autofill column B in series and determines the value at the end row, then autofill column C with that value in that row. For example:

ColumnA ColumnB ColumnC
-----------------------------------------
1 1(autofill startpt) 6
1 2 6
1 3 6
1 4 6
1 5 6
3 6(autofill endpt) 6
0 1(autofill start pt) 4
1 2 4
2 3 4
3 4(autofill endpt) 4
2 1(autofill start pt) 5
1 2 5
2 3 5
0 4 5
4 5(autofill endpt) 5

thx ahead.

 

[boolok2011]

I've kept searching the forum for answer but failed. Anyone can help? Thx ahead

 

[jim may]

Your last row shows: 4 5(autofill endpt) 5; Since Col A = 4 wouldn't Col B = 1 (be a Restart)?

 

[jim may]

OK, here you go.. Starting with just your Column A data, like so..

Excel Workbook
	A
1	1
2	1
3	1
4	1
5	1
6	3
7	0
8	1
9	2
10	3
11	2
12	1
13	2
14	0
15	4
Sheet1

Excel 2007

Run this Macro (put in a Standard module)

Sub Foo()
Dim i As Long, MyTot As Long
Application.ScreenUpdating = False
With Range("B1")
    .Select
    .Value = 1
    .Offset(1).Select
End With
Do Until ActiveCell.Offset(, -1) = ""
If Not ActiveCell.Offset(-1, -1) >= 3 Then
ActiveCell.Value = ActiveCell.Offset(-1, 0) + 1
Else
ActiveCell = 1
End If
ActiveCell.Offset(1).Select
Loop
Range("B1").Select
i = 1
Do Until ActiveCell = ""
If ActiveCell.Offset(1) > ActiveCell Then
ActiveCell.Offset(1).Select
Else
MyTot = ActiveCell.Value
Range(Cells(i, 3), Cells(ActiveCell.Row, 3)).Value = MyTot
i = ActiveCell.Row + 1
ActiveCell.Offset(1).Select
End If
Loop
Range("A1").Select
Application.ScreenUpdating = True
End Sub

 

[boolok2011]

Jim May, thx alot. The script works great!

However, if my starting column is not at A1 but AW5, and my autofill columns are BG5 and BH5 instead of B1 and C1. How can I modify your script so that it will work again? Please help again. Thx again.

John

 

[jim may]

Try.............

Sub Foo()
Dim i As Long, MyTot As Long
Application.ScreenUpdating = False
With Range("AX5")
    .Select
    .Offset(, 9).Value = 1
    .Offset(1).Select
End With
Do Until ActiveCell.Offset(, -1) = ""
If Not ActiveCell.Offset(-1, -1) >= 3 Then
ActiveCell.Offset(, 9).Value = ActiveCell.Offset(-1, 9) + 1
Else
ActiveCell.Offset(, 9) = 1
End If
ActiveCell.Offset(1).Select
Loop
Range("BG5").Select
i = 5
Do Until ActiveCell = ""
If ActiveCell.Offset(1) > ActiveCell Then
ActiveCell.Offset(1).Select
Else
MyTot = ActiveCell.Value
Range(Cells(i, 60), Cells(ActiveCell.Row, 60)).Value = MyTot
i = ActiveCell.Row + 1
ActiveCell.Offset(1).Select
End If
Loop
Range("AW5").Select
Application.ScreenUpdating = True
End Sub

 

[boolok2011]

Jim,

Great. It works amazingly! However, can you help further in two ways?

1. Actually I want to autofill series in BH (not BG) while the autofill in BG (not BH). I manage to modify the script for the former part and it works:

With Range("AX5")
.Select
.Offset(, 10).Value = 1 <--- Whenever I see (,9), I change it to (,10)
.Offset(1).Select
End With
Do Until ActiveCell.Offset(, -1) = ""
If Not ActiveCell.Offset(-1, -1) >= 3 Then
ActiveCell.Offset(, 10).Value = ActiveCell.Offset(-1, 10) + 1
Else
ActiveCell.Offset(, 10) = 1
End If
ActiveCell.Offset(1).Select
Loop

However, I don't know how to change the script such that it will autofill in BG.
Range("BH5").Select <------ I change "BG5" to "BH5"
i = 5
Do Until ActiveCell = ""
If ActiveCell.Offset(1) > ActiveCell Then
ActiveCell.Offset(1).Select
Else
MyTot = ActiveCell.Value
Range(Cells(i, 60), Cells(ActiveCell.Row, 60)).Value = MyTot
i = ActiveCell.Row + 1
ActiveCell.Offset(1).Select
End If
Loop
Range("AW5").Select
Application.ScreenUpdating = True
End Sub

2. I have 254 files in a folder that need to do with the above operation and save it. Is it possible to write a macro that will open the xls file and then do the above operation and then save it, close it and open the second file, etc. until the end of the file.

Thx again.

 

[jim may]

The VBA Dir() function would do it. Look it up in Help

 

[boolok2011]

Jim, Thx for your prompt reply.

Indeed, I have found a script that will read the file in the folder and I incorporate your script with it.

However, when I run macro, it will loop endlessly. I don't know what's wrong with the script. Can you help to take a look?

Sub Macro()

Dim strPath As String
Dim strFile As String
Dim wkbOpen As Workbook
Dim wksOpen As Worksheet
Dim wksDest As Worksheet

Application.ScreenUpdating = False

strPath = "C:\Users\Domenic\Desktop\Test\"
If Right(strPath, 1) <> "\" Then strPath = strPath & "\"
strFile = Dir(strPath & "*.xls")

Do While Len(strFile) > 0
Set wkbOpen = Workbooks.Open(strPath & strFile)
Set wksOpen = wkbOpen.Worksheets("Sheet2")

With Range("AX5")
.Select
.Offset(, 10).Value = 1
.Offset(1).Select
End With
Do Until ActiveCell.Offset(, -1) = ""
If Not ActiveCell.Offset(-1, -1) >= 3 Then
ActiveCell.Offset(, 10).Value = ActiveCell.Offset(-1, 10) + 1
Else
ActiveCell.Offset(, 10) = 1
End If
ActiveCell.Offset(1).Select
Loop
Range("BH5").Select
i = 5
Do Until ActiveCell = ""
If ActiveCell.Offset(1) > ActiveCell Then
ActiveCell.Offset(1).Select
Else
MyTot = ActiveCell.Value
Range(Cells(i, 60), Cells(ActiveCell.Row, 60)).Value = MyTot
i = ActiveCell.Row + 1
ActiveCell.Offset(1).Select
End If
Loop
Range("AW5").Select

Loop

Application.ScreenUpdating = True
End Sub

 

[jim may]

What version excel are you?