Home |
Search |
Today's Posts |
|
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Inserting 2 columns when cells don't match
I've created this routing which works but I was hoping for something a
little more clean Range("D2").Select Do Until ActiveCell.Offset(0, 1) = "" If ActiveCell.Offset(0, 1) < ActiveCell Then Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(0, 2)).EntireColumn.Insert shift:=xlToRight ActiveCell.Offset(0, 3).Select Else ActiveCell.Offset(0, 1).Select End If Loop I had tried the following but it's not working For Each cell In Range(("D2"), Range("D2").End(xlToRight)) If cell.Offset(0, 1) < cell And cell.Offset(0, 1) < "" Then Range(cell.Offset(0, 1), cell.Offset(0, 2)).EntireColumn.Insert 'shift:=xlToRight cell.Offset(0, 3).Select Else End If Next |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Inserting 2 columns when cells don't match
I find it much easier to work with the column numbers and looping from the
rightmost toward the left in cases like this (and starting at the bottom and working toward the top when working with rows). Option Explicit Sub testme() Dim iCol As Long Dim FirstCol As Long Dim LastCol As Long Dim wks As Worksheet Set wks = Worksheets("sheet1") 'ActiveSheet ??? With wks FirstCol = .Range("D2").Column '4 LastCol = .Range("D2").End(xlToRight).Column For iCol = LastCol To FirstCol + 1 Step -1 If .Cells(2, iCol).Value < .Cells(2, iCol - 1).Value Then .Cells(2, iCol).Resize(, 2).EntireColumn.Insert End If Next iCol End With End Sub On 11/12/2010 12:29, Frank wrote: I've created this routing which works but I was hoping for something a little more clean Range("D2").Select Do Until ActiveCell.Offset(0, 1) = "" If ActiveCell.Offset(0, 1)< ActiveCell Then Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(0, 2)).EntireColumn.Insert shift:=xlToRight ActiveCell.Offset(0, 3).Select Else ActiveCell.Offset(0, 1).Select End If Loop I had tried the following but it's not working For Each cell In Range(("D2"), Range("D2").End(xlToRight)) If cell.Offset(0, 1)< cell And cell.Offset(0, 1)< "" Then Range(cell.Offset(0, 1), cell.Offset(0, 2)).EntireColumn.Insert 'shift:=xlToRight cell.Offset(0, 3).Select Else End If Next -- Dave Peterson |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Inserting 2 columns when cells don't match
Thanks you to all who responded.
To Don Guillett: Your solution works only every two steps, that is it only insert two new columns every other time instead of every time. To Dave Peterson: You are always the man and your solution works perfectly. I wish I could understand your code. Regards, |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Inserting 2 columns when cells don't match
It's not too complex <bg.
I'll add some comments. Option Explicit Sub testme() 'some variables. 'column variables for first column, last column and looping column Dim iCol As Long Dim FirstCol As Long Dim LastCol As Long 'just to make it easier to change the worksheet name if you want. Dim wks As Worksheet Set wks = Worksheets("sheet1") 'ActiveSheet ??? With wks 'the first, er, leftmost, column starts in column D (column 4) FirstCol = .Range("D2").Column '4 'the rightmost column is determined the same way you did. 'select D2 and hit End and then right arrow 'then use that cell's column number LastCol = .Range("D2").End(xlToRight).Column 'start at the righthand column and go towards the lefthand column 'but stop looking at column E. 'Since the code looks to the column to the left of the "looping" column 'and the column to the left of column E is column D -- where you were 'stopping For iCol = LastCol To FirstCol + 1 Step -1 'if the value in the looping column is different from the value 'directly to its left (icol compared with icol-1), then 'do the work of inserting two columns If .Cells(2, iCol).Value < .Cells(2, iCol - 1).Value Then .Cells(2, iCol).Resize(, 2).EntireColumn.Insert End If Next iCol End With End Sub On 11/13/2010 11:51, Frank wrote: Thanks you to all who responded. To Don Guillett: Your solution works only every two steps, that is it only insert two new columns every other time instead of every time. To Dave Peterson: You are always the man and your solution works perfectly. I wish I could understand your code. Regards, -- Dave Peterson |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Inserting 2 columns when cells don't match
On Nov 12, 12:29*pm, Frank wrote:
I've created this routing which works but I was hoping for something a little more clean Range("D2").Select Do Until ActiveCell.Offset(0, 1) = "" * * If ActiveCell.Offset(0, 1) < ActiveCell Then * * * * Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(0, 2)).EntireColumn.Insert shift:=xlToRight * * * * ActiveCell.Offset(0, 3).Select * * * * Else * * * * ActiveCell.Offset(0, 1).Select * * End If Loop I had tried the following but it's not working For Each cell In Range(("D2"), Range("D2").End(xlToRight)) * * If cell.Offset(0, 1) < cell And cell.Offset(0, 1) < "" Then * * * * Range(cell.Offset(0, 1), cell.Offset(0, 2)).EntireColumn.Insert 'shift:=xlToRight * * * * cell.Offset(0, 3).Select * * * * Else * * End If Next Something simple like this? Sub insertcolsifnomatch() Dim i As Long For i = Cells(2, Columns.Count).End(xlToLeft).Column To 4 Step -2 If Cells(2, i - 1) < Cells(2, i) Then Columns(i).Resize(, 2).Insert Next i End Sub |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
Inserting 2 columns when cells don't match
If the contents of D2 to the end of the row are constants (that is, they NOT
the result of formulas), then you could consider using this non-looping code... With Range("D2", Cells(2, Columns.Count).End(xlToLeft)) .Replace .Cells(1), "=" & .Cells(1), xlWhole .SpecialCells(xlCellTypeConstants).Offset(0, 1).Insert xlShiftToRight .SpecialCells(xlCellTypeConstants).Offset(0, 1).Insert xlShiftToRight .SpecialCells(xlCellTypeFormulas).Replace "=", "", xlPart End With -- Rick Rothstein (MVP - Excel) "Frank" wrote in message ... I've created this routing which works but I was hoping for something a little more clean Range("D2").Select Do Until ActiveCell.Offset(0, 1) = "" If ActiveCell.Offset(0, 1) < ActiveCell Then Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(0, 2)).EntireColumn.Insert shift:=xlToRight ActiveCell.Offset(0, 3).Select Else ActiveCell.Offset(0, 1).Select End If Loop I had tried the following but it's not working For Each cell In Range(("D2"), Range("D2").End(xlToRight)) If cell.Offset(0, 1) < cell And cell.Offset(0, 1) < "" Then Range(cell.Offset(0, 1), cell.Offset(0, 2)).EntireColumn.Insert 'shift:=xlToRight cell.Offset(0, 3).Select Else End If Next |
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
Inserting 2 columns when cells don't match
If the contents of D2 to the end of the row are constants (that is, they NOT
the result of formulas), then you could consider using this non-looping code... With Range("D2", Cells(2, Columns.Count).End(xlToLeft)) .Replace .Cells(1), "=" & .Cells(1), xlWhole .SpecialCells(xlCellTypeConstants).Offset(0, 1).Insert xlShiftToRight .SpecialCells(xlCellTypeConstants).Offset(0, 1).Insert xlShiftToRight .SpecialCells(xlCellTypeFormulas).Replace "=", "", xlPart End With -- Rick Rothstein (MVP - Excel) "Frank" wrote in message ... I've created this routing which works but I was hoping for something a little more clean Range("D2").Select Do Until ActiveCell.Offset(0, 1) = "" If ActiveCell.Offset(0, 1) < ActiveCell Then Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(0, 2)).EntireColumn.Insert shift:=xlToRight ActiveCell.Offset(0, 3).Select Else ActiveCell.Offset(0, 1).Select End If Loop I had tried the following but it's not working For Each cell In Range(("D2"), Range("D2").End(xlToRight)) If cell.Offset(0, 1) < cell And cell.Offset(0, 1) < "" Then Range(cell.Offset(0, 1), cell.Offset(0, 2)).EntireColumn.Insert 'shift:=xlToRight cell.Offset(0, 3).Select Else End If Next |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
How to get notified when inserting cells, rows, or columns in Exce | Excel Programming | |||
Compare cells and copy columns after match | Excel Worksheet Functions | |||
inserting columns, writing in cells | Excel Programming | |||
Can parital cells be underlined w/o inserting blank columns? | Excel Discussion (Misc queries) | |||
Match cells by columns | Excel Programming |