i'm trying to tweak my macro so that it creates a column next to a specific column that always changes positions. In the macro i have below, it is just an absolute reference of 6 columns to the left. However, this wont always be the case. Should I set this up by finding the column name in the top row?
Basically the macro creates a new column and puts in an IF statement if it is a duplicate, and then sets up conditional formatting to highlight all the values of "1". Sorry if i am not explaining this clearly!
Sub test()
Columns("L:L").Select
Selection.Insert Shift:=xlToRight
Range("L2").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-6]=R[-1]C[-6],R[-1]C+1,1)"
Range("L2").Select
Selection.Copy
Range("K2").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, 1).Select
Range(Selection, Selection.End(xlUp)).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Calculate
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
Formula1:="=1"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Font
.Color = -16383844
.TintAndShade = 0
End With
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 13551615
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
End Sub
I have a working code for this but it requires that your data be in a table. This is the best way to dynamically manipulate and reference the data (Columns, Rows, etc..)
Also I heavily rely on the ListObject method. It really handles tables well.
Public Sub InsertColumn(Optional columnName As String, Optional BeforeORAfter As String)
Dim loTableName As ListObject
Dim loColumn As ListColumn
Dim newColDest As Long
'Handles user input if they desire the column inserted before or after
Select Case UCase(BeforeORAfter)
Case Is = "BEFORE"
newColDest = 0 'Inserts column and moves reference column right
Case Else
newColDest = 1 'Inserts column to the right of reference column
End Select
'Ensures the user selects a reference column name
Select Case columnName
Case Is = ""
columnName = InputBox("Enter column name to be referenced.", "Enter Column Name")
Case Else
End Select
'Sets the ListObject as the table.
Set loTableName = Range("TableName").ListObject
With loTableName
On Error GoTo InsertError 'Exits sub in case the column couldn't be found
.ListColumns.Add (.ListColumns(columnName).Index + newColDest)
End With
Exit Sub
InsertError:
'Most likely error is user typed the column header incorrectly.
MsgBox "Error creating column. Ensure a correct reference column was chosen", vbExclamation + vbOKOnly, "Insert Error"
End Sub
Any questions or problems, just let me know.
This below would be something you can work with (it will ask the column to search and perform the actions in your recorded macro... Check my website http://multiskillz.tekcities.com/k2500_0vbaMenu.html
Sub test_modified()
'worksheet workbook object
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets(1)
'range object to select a column
Dim fRng As Variant
fRng = Application.InputBox(Prompt:="value to find", Title:="InputBox Method", Type:=2)
'range object to find the column
Dim colRng As Range
Set colRng = ws.Rows(1)
'find column
Dim fcol As Range
Set fcol = colRng.Find(fRng, LookIn:=xlValues, lookat:=xlPart, MatchCase:=False)
'convert the column address to a number
Dim colNb As Byte
colNb = fcol.Column
'going on from your recorded macro
'Columns("L:L").Select
ws.Columns(colNb).Select
Selection.Insert Shift:=xlToRight
Range("L2").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-6]=R[-1]C[-6],R[-1]C+1,1)"
Range("L2").Select
Selection.Copy
Range("K2").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, 1).Select
Range(Selection, Selection.End(xlUp)).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Calculate
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
Formula1:="=1"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Font
.Color = -16383844
.TintAndShade = 0
End With
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 13551615
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
End Sub
Cheers Pascal
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.