CODEWITHSUNDEEP
excelvba
George OST
George OST

Reputation: 51

Add extra information in a new column

I want to make a macro to add extra information into my reports.

Inputs:
enter image description here

Outputs:
enter image description here

Sometimes the "Message" column is not in the same position (can be in B,D or E column). So i was thinking on some steps:
1. Find the "Message" column.
2. Insert column on left.
3. Add the extra info based on different cases. (here is the problem)

Sub Extra()

    With Worksheets(1).Range("a1:x1")
        Set c = .FIND("Message", LookIn:=xlValues)
        If Not c Is Nothing Then
           c.EntireColumn.Select
            Selection.Insert
            End If
      End With

    '3rd step
    Dim d As Range
     For Each d In Selection
      Select Case d.Value
       Case Is = "D1"
       'add text CCC

       Case Is = "D2"
      'add text BBB 

       Case Is = "D345"
       'add text CCC

      End Select
      Next d

End sub

How can I make this macro?

Upvotes: 1

Views: 25

Answers (1)

Xabier
Xabier

Reputation: 7735

I've managed to test this out and it works as you expect:

Sub foo()
 Set res = Sheet1.Cells(1, 1).EntireRow.Find(What:="Message", LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False) 'Find column with header of "Message"
 ColumnNumber = res.Column 'Get ColumnNumber
 Columns(ColumnNumber).EntireColumn.Insert 'Insert a new column
 LastRow = Sheet1.Cells(Sheet1.Rows.Count, "A").End(xlUp).Row ' Find the last Row on column A
 Sheet1.Cells(1, ColumnNumber).Value = "Extra Info" 'add header for new column
 For i = 2 To LastRow 'loop through the sheet to add the extra info
    If Sheet1.Cells(i, ColumnNumber + 1).Value = "D1" Then Sheet1.Cells(i, ColumnNumber).Value = "AAA"
    If Sheet1.Cells(i, ColumnNumber + 1).Value = "D2" Then Sheet1.Cells(i, ColumnNumber).Value = "BBB"
    If Sheet1.Cells(i, ColumnNumber + 1).Value = "D345" Then Sheet1.Cells(i, ColumnNumber).Value = "CCC"
 Next i
End Sub

Upvotes: 1

Related Questions