PDA

View Full Version : To Compare two cells in row and insert column



rider
04-01-2013, 11:26 PM
Hi All... I am new to VBA. I am creating a macro to do some filtering and vlookup with 2 Excels. But I am stuck now at the last stage where,
1. I need to compare the cells in one row (the value of the cells are the result of another function MONTH, from the row 3)
2. And when there is a difference in the value of two cells, i need to insert a column in between those two cells (example: i need to insert a column after the December and before January)
3. And name the first cell (name December)
4. And insert a SUM function for the entire cells in that column to add the cells after the last insertion of last column.

I did try macro recording, but you know i am stuck at expanding it.

I am pasting the code i recorded below, for the reference.

Thanks in advance.

********

Sub Monthcompare()
'
' Monthcompare Macro
'

' Rows("2:2").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("G2").Select
ActiveCell.FormulaR1C1 = "=MONTH(R[-1]C)"
Range("G1").Select
Selection.End(xlToRight).Select
Range("DA22").Select
Range(Selection, Selection.End(xlToLeft)).Select
Selection.FillRight
'Range("G2").Select
'Selection.AutoFill Destination:=Range("G2:DI2"), Type:=xlFillDefault
'Range("G2:DI2").Select

Columns("K:K").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("K1").Select
ActiveCell.FormulaR1C1 = "'October"
Range("K3").Select
ActiveCell.FormulaR1C1 = "=SUM(RC[-4]:RC[-1])"
Range("K3").Select
Selection.AutoFill Destination:=Range("K3:K203")
Range("K3:K203").Select
Columns("P:P").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("P1").Select
ActiveCell.FormulaR1C1 = "'November"
Range("P3").Select
ActiveCell.FormulaR1C1 = "=SUM(RC[-4]:RC[-1])"
Range("P3").Select
Selection.AutoFill Destination:=Range("P3:P203")
Range("P3:P203").Select
Columns("V:V").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("V1").Select
ActiveCell.FormulaR1C1 = "'January"
Range("V3").Select
ActiveCell.FormulaR1C1 = "=SUM(RC[-5]:RC[-1])"
Range("V3").Select
Selection.AutoFill Destination:=Range("V3:V203")
Range("V3:V203").Select
Windows("Test1.xlsx").Activate
End Sub

********

mdmackillop
04-02-2013, 02:24 PM
Can you post a sample workbook showing original and desired result. Use Manage Attachments in the Go Advanced reply section.

rider
04-04-2013, 04:18 AM
I have attached the file. In the sheet RESULT, you can see some columns colored in yellow. I have added a new row in same sheet to add the function MONTH. Basically i want to identify the date (G2:DM2) belongs to which month, and use a formula to compare the cells (G1:DM1) in the first row and find out where the months ends, and add a column after month ends, give the months name in the new column, and insert SUM (to add the columns starting from the last month to this month, in here it will be G3:J3 for October and L3:O3 for November).

Hope I have not confused you...

Thanks in advance.

mdmackillop
04-04-2013, 01:13 PM
Option Explicit

Sub Macro1()
Dim c As Long, r As Long, i As Long
Dim Cols As Long
Dim cel As Range

Rows("1:1").Insert
c = Cells(2, Columns.Count).End(xlToLeft).Column
r = Cells(Rows.Count, 1).End(xlUp).Row

'Month numbers
For i = c To 6 Step -1
Cells(1, i) = Month(Cells(2, i))
Next

'Insert columns
c = Cells(2, Columns.Count).End(xlToLeft).Column
For i = c To 6 Step -1
If Cells(1, i) <> Cells(1, i - 1) Then
Cells(1, i).EntireColumn.Insert
End If
Next


For i = c To 6 Step -1
If Cells(2, i) = "" Then
Set cel = Cells(2, i)
Cols = cel(2).Column - cel(2, -1).End(xlToLeft).Column
'Month name
cel.Formula = MonthName(cel.Offset(-1, -1))
'Add formulae
cel.Offset(1).Resize(r - 2).FormulaR1C1 = "=SUM(R[]C[" & -Cols & "]:R[]C[-1])"
'Colour cells
cel.Resize(r - 1).Interior.ColorIndex = 6
End If
Next
'Delete extra inserted column
Columns(7).Delete

End Sub

rider
04-04-2013, 10:43 PM
Thank You so much for working on this. To be frank, I do not understand even a single line in the code. So i need your help again. Macro is giving a "Run-time Error 5".
I am attaching the screenshots of the error and the file till where it stopped.

Once again thank you so much. You really made my day.... :beerchug:

Sorry, couldn't attach more than one file.
The error description "Run-time error 5 - Invalid procedure call or argument"
The error line was

For i = c To 6 Step -1
If Cells(2, i) = "" Then
Set cel = Cells(2, i)
Cols = cel(2).Column - cel(2, -1).End(xlToLeft).Column
'Month name
cel.Formula = MonthName(cel.Offset(-1, -1))
'Add formulae
cel.Offset(1).Resize(r - 2).FormulaR1C1 = "=SUM(R[]C[" & -Cols & "]:R[]C[-1])"
'Colour cells
cel.Resize(r - 1).Interior.ColorIndex = 6
End If

mdmackillop
04-06-2013, 09:03 AM
Sorry, Issues with crazy american dates!
Sub Macro1()
Dim c As Long, r As Long, i As Long
Dim Cols As Long
Dim cel As Range
Dim arr()
Dim j

Application.ScreenUpdating = False
Rows("1:1").Insert
c = Cells(2, Columns.Count).End(xlToLeft).Column
r = Cells(Rows.Count, 1).End(xlUp).Row

'Month numbers
For i = c To 6 Step -1
Cells(1, i) = Month(Cells(2, i))
Next

'Insert columns
c = Cells(2, Columns.Count).End(xlToLeft).Column
For i = c To 6 Step -1
If Cells(1, i) <> Cells(1, i - 1) Then
Cells(1, i).EntireColumn.Insert
End If
Next

c = Cells(2, Columns.Count).End(xlToLeft).Column + 1
ReDim arr(c)
For i = 6 To c
If Cells(1, i) = "" Then
arr(j) = i
j = j + 1
End If
Next
ReDim Preserve arr(j)

'Create array of columns
For i = 1 To j - 1
Set cel = Cells(2, arr(i))
'Month name
cel.Formula = MonthName(cel.Offset(-1, -1))
'Add formulae

cel.Offset(1).Resize(r - 2).FormulaR1C1 = "=SUM(RC" & arr(i - 1) + 1 & ":RC" & arr(i) - 1 & ")"
'Colour cells
cel.Resize(r - 1).Interior.ColorIndex = 6

Next
'Delete extra inserted column
Columns(6).Delete
Application.ScreenUpdating = True
End Sub

mckeown55
04-08-2013, 06:56 AM
that was very helpful indeed