CODEWITHSUNDEEP
vbaexcel
Farmer
Farmer

Reputation: 11003

Replace data in an Excel file using macros

I have an Excel file which contains some data in a 2d array.

Excel document

What I want to do is to create a macro which can replace the asterisk '*' by the header of the column of the table (toto, or tata, or titi).

Upvotes: 2

Views: 5271

Answers (3)

andy holaday
andy holaday

Reputation: 2302

Using just worksheet tools (no VBA):

  • Ctrl-F
  • Find what = ~*
  • Find All
  • Ctrl-A to select all the Find results
  • Close the Find dialog
  • Assuming your headers in row two, and assuming the cursor lands in column C somewhere (mine did twice, YMMV), type formula =C$2
  • Press Ctrl-Enter

Upvotes: 3

Bryan
Bryan

Reputation: 1893

Here is a simple way I came up with. 

i = 3
While Cells(2, i).Value <> ""
    Range(Cells(3, i), Cells(6, i)).Select

    Selection.Replace What:="~*", Replacement:=Cells(2, i).Value, LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False
    i = i + 1
Wend

Cells(x,y): x refers to row, y refers to column.

A more refined range select can be used instead of this basic one to have the code choose the appropriate range.

To implement in excel simply open up the code window and paste this code in the desired macro/subroutine.

Upvotes: 0

Siddharth Rout
Siddharth Rout

Reputation: 149335

Like this?

Option Explicit

Sub Sample()
    Dim oRange As Range, aCell As Range, bCell As Range
    Dim ws As Worksheet
    Dim ExitLoop As Boolean

    On Error GoTo Whoa

    '~~> Change this to the relevant sheet name
    Set ws = Worksheets("Sheet1")

    Set oRange = ws.Cells

    Set aCell = oRange.Find(What:="~*", LookIn:=xlValues, _
                LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                MatchCase:=False, SearchFormat:=False)

    If Not aCell Is Nothing Then
        Set bCell = aCell
        '~~> Assuming that the headers are in row 2
        aCell.Value = Cells(2, aCell.Column)
        Do While ExitLoop = False
            Set aCell = oRange.FindNext(After:=aCell)

            If Not aCell Is Nothing Then
                If aCell.Address = bCell.Address Then Exit Do
                '~~> Assuming that the headers are in row 2
                aCell.Value = Cells(2, aCell.Column)
            Else
                ExitLoop = True
            End If
        Loop
    End If
    Exit Sub
Whoa:
    MsgBox Err.Description
End Sub

Upvotes: 5

Related Questions