vba Insert Column and add values to empty cells

[gtd526]

Hello,
Need to insert a new column before Row(3:3) has a value (date).
Then insert "44" to1st cell in new column, and the occupied value (date) in 2nd cell.
There are several columns (A:AUI). Add the Cell color to Identify the change.
Thank you.

Here's how the outcome will look:
Before:

NBA.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S
1	PHI	LAL	ORL	WAS	HOU	NO	CHI	CLE	NYK	OKC	CHA	DEN	DAL	POR	MIL	LAC	NO	SAN	CHI
2	BOS	GS	DET	IND	ATL	BKN	MIA	TOR	MEM	MIN	SAN	UTA	PHX	SAC	PHI	LAL	CHA	IND	WAS
3	10/18/22		10/19/22												10/20/22		10/21/22
Raw

After:

NBA.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U	V	W
1	44	PHI	LAL	44	ORL	WAS	HOU	NO	CHI	CLE	NYK	OKC	CHA	DEN	DAL	POR	44	MIL	LAC	44	NO	SAN	CHI
2	10/18/22	BOS	GS	10/19/22	DET	IND	ATL	BKN	MIA	TOR	MEM	MIN	SAN	UTA	PHX	SAC	10/20/22	PHI	LAL	10/21/22	CHA	IND	WAS
Raw

 

[portews]

Try this:

Sub move_date()
Dim i as Long
Dim LastCol as Long
'finds the last column
:astCol = Cells(1, Columns.Count).End(xlToLeft).Column
'loops through the columns
For i = 1 To LastCol
    'checks for something in the 3rd row
    If Cells(3, i) > "" Then
        'insert the column before
        Cells(3, i).EntireColumn.Insert
        'add the 44 in row 1
        Cells(1, i) = "44"
        'copy the date into row 2
        Cells(2, i) = Format(Cells(3, i + 1), "mm/dd/yyyy")
        'change the color
        Range(Cells(1, i), Cells(2, i)).Interior.ColorIndex = 36
        'clear the original date
        Cells(3, i + 1).ClearContents
    End If
Next i
End Sub

 

[gtd526]

Try this:

Sub move_date()
Dim i as Long
Dim LastCol as Long
'finds the last column
:astCol = Cells(1, Columns.Count).End(xlToLeft).Column
'loops through the columns
For i = 1 To LastCol
    'checks for something in the 3rd row
    If Cells(3, i) > "" Then
        'insert the column before
        Cells(3, i).EntireColumn.Insert
        'add the 44 in row 1
        Cells(1, i) = "44"
        'copy the date into row 2
        Cells(2, i) = Format(Cells(3, i + 1), "mm/dd/yyyy")
        'change the color
        Range(Cells(1, i), Cells(2, i)).Interior.ColorIndex = 36
        'clear the original date
        Cells(3, i + 1).ClearContents
    End If
Next i
End Sub

it does nothing. it goes straight to End Sub

 

[gtd526]

Try this:

Sub move_date()
Dim i as Long
Dim LastCol as Long
'finds the last column
:astCol = Cells(1, Columns.Count).End(xlToLeft).Column
'loops through the columns
For i = 1 To LastCol
    'checks for something in the 3rd row
    If Cells(3, i) > "" Then
        'insert the column before
        Cells(3, i).EntireColumn.Insert
        'add the 44 in row 1
        Cells(1, i) = "44"
        'copy the date into row 2
        Cells(2, i) = Format(Cells(3, i + 1), "mm/dd/yyyy")
        'change the color
        Range(Cells(1, i), Cells(2, i)).Interior.ColorIndex = 36
        'clear the original date
        Cells(3, i + 1).ClearContents
    End If
Next i
End Sub

now I see there might be a typo.
: should be L

 

[gtd526]

Try this:

Sub move_date()
Dim i as Long
Dim LastCol as Long
'finds the last column
:astCol = Cells(1, Columns.Count).End(xlToLeft).Column
'loops through the columns
For i = 1 To LastCol
    'checks for something in the 3rd row
    If Cells(3, i) > "" Then
        'insert the column before
        Cells(3, i).EntireColumn.Insert
        'add the 44 in row 1
        Cells(1, i) = "44"
        'copy the date into row 2
        Cells(2, i) = Format(Cells(3, i + 1), "mm/dd/yyyy")
        'change the color
        Range(Cells(1, i), Cells(2, i)).Interior.ColorIndex = 36
        'clear the original date
        Cells(3, i + 1).ClearContents
    End If
Next i
End Sub

I corrected the typo.
works perfectly.
Thank you.

 

[gtd526]

Try this:

Sub move_date()
Dim i as Long
Dim LastCol as Long
'finds the last column
:astCol = Cells(1, Columns.Count).End(xlToLeft).Column
'loops through the columns
For i = 1 To LastCol
    'checks for something in the 3rd row
    If Cells(3, i) > "" Then
        'insert the column before
        Cells(3, i).EntireColumn.Insert
        'add the 44 in row 1
        Cells(1, i) = "44"
        'copy the date into row 2
        Cells(2, i) = Format(Cells(3, i + 1), "mm/dd/yyyy")
        'change the color
        Range(Cells(1, i), Cells(2, i)).Interior.ColorIndex = 36
        'clear the original date
        Cells(3, i + 1).ClearContents
    End If
Next i
End Sub

[/QUOTE]

Try this:

Sub move_date()
Dim i as Long
Dim LastCol as Long
'finds the last column
:astCol = Cells(1, Columns.Count).End(xlToLeft).Column
'loops through the columns
For i = 1 To LastCol
    'checks for something in the 3rd row
    If Cells(3, i) > "" Then
        'insert the column before
        Cells(3, i).EntireColumn.Insert
        'add the 44 in row 1
        Cells(1, i) = "44"
        'copy the date into row 2
        Cells(2, i) = Format(Cells(3, i + 1), "mm/dd/yyyy")
        'change the color
        Range(Cells(1, i), Cells(2, i)).Interior.ColorIndex = 36
        'clear the original date
        Cells(3, i + 1).ClearContents
    End If
Next i
End Sub

Your code works, but it stops inserting at column AUI, which is the last column at the beginning of code.
As code inserts columns, its adding columns. Therefore, maybe columns have to be recalculated after each insert?
Or when to code hits column(AUI) or (1231)column number, then recalculate?

 

[portews]

Good point. You might be able to get away with adding a line just before the end if statement:

LastCol =LastCol+1

I'm not near her machine with Excel on it right now, so it's not tested, but try that out.

 

[gtd526]

Good point. You might be able to get away with adding a line just before the end if statement:

LastCol =LastCol+1

I'm not near her machine with Excel on it right now, so it's not tested, but try that out.

It wasn't adding enough to LastCol, so I changed the '1 to LastCol' to '1 to 1405'.
Giving it more than enough Col count to calculate.
And it worked.