VBA Macro: The formula is based on a column that changes places

I am trying to tweak my macro so that it creates a column next to a specific column that always changes positions. In the macro below, it's just an absolute link of 6 columns to the left. However, this is not always the case. Should I fix this by finding the column name in the top row?

Basically, a macro creates a new column and places it in an IF statement if it is a duplicate, and then sets the conditional formatting to highlight all the values ​​of "1". Sorry if I do not explain it 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
+4
source share
2 answers

, , . (, ..).

ListObject. .

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

, .

+1

, ( ... 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

Pascal

0

Source: https://habr.com/ru/post/1529465/


All Articles