1

Apologies... my VBA skills are pretty much non-existent....

What I am trying to do is to create a macro in Excel, where data in a column (1) is replaced by the column header (SAND, LS and CS). Here is an example table:

DEPTH SAND LS CS
600 1 -999 -999
700 -999 -999 1
800 1 -999 -999
900 -999 1 -999

And here is the result when I run the macro:

DEPTH SAND LS CS
600 SAND -999 -999
700 -999 -999 CS
800 SAND -999 -999
900 -999 LS -999

However, what I need is for Excel to read the Header in the first row to replace 1. Not the column letter (for example read SAND and not Columns("B:B") in the code below. I have many different files of the same format, but with different numbers of columns and different column headers, hence the question.

Here is an example of the macro I created.

Sub LithReplace()
'
' LithReplace Macro
'

'
    Range("B1").Select
    Selection.Copy
    Columns("B:B").Select
    Selection.Replace What:="1", Replacement:="SAND            ", LookAt:= _
        xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
    Range("C1").Select
    Application.CutCopyMode = False
    Selection.Copy
    Columns("C:C").Select
    Selection.Replace What:="1", Replacement:="LS              ", LookAt:= _
        xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
    Range("D1").Select
    Application.CutCopyMode = False
    Selection.Copy
    Columns("D:D").Select
    Selection.Replace What:="1", Replacement:="CS               ", LookAt:= _
        xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
End Sub

Thanks in advance.

Pᴇʜ
  • 56,719
  • 10
  • 49
  • 73
Ikeshima
  • 19
  • 5
  • You might benefit from reading [How to avoid using Select in Excel VBA](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba). – Pᴇʜ Feb 23 '21 at 08:18
  • Please check out the answer I wrote below. The link is just a note for you to understand how to write better code. Please don't post code in comments. It gets useless as you cannot format it correctly. – Pᴇʜ Feb 23 '21 at 08:40
  • Thank you! That has worked perfectly. I will add a more code to this complete the workflow. – Ikeshima Feb 23 '21 at 08:42

3 Answers3

3

Try:

Sub test()
Dim rng As Range
Dim MyColumn As Range
Set rng = Range("A1").CurrentRegion 'dataset. Replace A1 by top left cell reference

For Each MyColumn In rng.Columns
    If MyColumn.Column > 1 Then 'we skip first column
        MyColumn.Replace "1", MyColumn.Cells(1, 1).Value, xlPart 'replace 1 with 'top cell of each column
    End If
Next MyColumn

Set rng = Nothing
End Sub

The code will loop trough each column and will replace any 1 with top cell value from each column, so it will work with any columns quantity

I get this after executing code:

enter image description here

IMPORTANT: Consider using xlWhole instead of xlPart, because right now if there is any 1 it will be replaced, so something like 213 could get converted into 2SAND3.

Range.Replace method (Excel)

  • lol we wrote the same answer with almost same examples for `xlWhole` ^^ – Pᴇʜ Feb 23 '21 at 08:34
  • 1
    @Pᴇʜ Yeah, I was reading your answer and thought the same haha. I guess both of us have had trust issues with `Range.Replace` and we'll never forget, lol – Foxfire And Burns And Burns Feb 23 '21 at 08:45
  • fyi you might be interested in an alternative approach using a one line evaluation :-) – T.M. Feb 23 '21 at 09:14
  • @T.M. I guess you mean the `If...End IF` I used common syntax for OP to be easier to understand, because OP said *my VBA skills are pretty much non-existent*. But indeed, it could be 1 single line like `If MyColumn.Column > 1 Then MyColumn.Replace "1", MyColumn.Cells(1, 1).Value, xlPart`. Thanks for pointing that out! – Foxfire And Burns And Burns Feb 23 '21 at 10:08
  • @FoxfireAndBurnsAndBurns the syntax is perfectly ok (+1); just wanted to draw your attention to my own (late) response using a one liner based on a predefined formula string: `rng.Value = Evaluate(myFormula)` – T.M. Feb 23 '21 at 10:44
2

Do something generic like below:

  1. Define your worksheet
  2. Find out how many columns there are
  3. Define the range where the replacement needs to be done. Here we want to go from column 2 to the last one and spare out the first column.
  4. Loop column wise to replace the 1 in each column by its header.

For Example

Option Explicit

Public Sub LithReplace()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("Sheet1") 'specify your sheet name
    
    Dim LastUsedColumn As Long 'find the last used column in the header row
    LastUsedColumn = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
    
    Dim RangeToReplace As Range 'range to replace is from column 2 to the last used column
    Set RangeToReplace = ws.Range(ws.Columns(2), ws.Columns(LastUsedColumn))
    
    Dim Column As Range
    For Each Column In RangeToReplace.Columns 'loop through all columns in that range
        'in each column replace "1" with the value in the header cell of that column Column.Cells(1, 1)
        Column.Replace What:="1", Replacement:=Column.Cells(1, 1), _
                       LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
                       ReplaceFormat:=False
        
    Next Column
End Sub

Note that you need to LookAt:=xlWhole otherwise if you LookAt:=xlPart and there is a number that contains a 1 like 614 it will replace to 6SAND4.

Pᴇʜ
  • 56,719
  • 10
  • 49
  • 73
  • 1
    fyi you might be interested in an alternative approach using a one line evaluation @PEH :-) – T.M. Feb 23 '21 at 09:15
  • 1
    @T.M. Nice alternative approach. Would be interesting which are the advantages of one over the other, eg. which one is faster. – Pᴇʜ Feb 23 '21 at 09:18
  • Could be worth a try; might depend on the number of columns to be replaced in iteration and the fact that you are addressing whole columns @PEH – T.M. Feb 23 '21 at 09:28
  • 1
    @T.M. Replaceing whole columns vs. only the rows that have data doesn't change anything. Excel is smart enough to omit empty rows in the end. – Pᴇʜ Feb 23 '21 at 09:42
1

Alternative via Evaluate()

Basically a one liner: rng.Value = Evaluate(myFormula)

Sub ReplaceNumberOne()
    'a) define data range
    With Sheet1                  ' << change to wanted project's sheet Code(Name)
        Dim LastRow As Long, LastCol As Long
        LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
    
        Dim rng As Range
        Set rng = .Range("A1", .Columns(LastCol)).Resize(LastRow)
        
    End With
    'b) define range addresses (strings)
    Dim dataAddr As String, headAddr As String
    dataAddr = rng.Address: headAddr = rng.Resize(1, LastRow).Address
    'c) define formula to be evaluated
    Dim myFormula As String          ' e.g. "=if(A1:D5=1,A1:D1,A1:D5&"""")"
    myFormula = Replace(Replace("=if(x=1,y,x&"""")", "x", dataAddr), "y", headAddr)
    Debug.Print myFormula
    '~~~~~~~~~~~~~~~~~~~~~~~~
    'd) replace by one code line
    '~~~~~~~~~~~~~~~~~~~~~~~~
    rng.Value = Evaluate(myFormula)
End Sub

T.M.
  • 9,436
  • 3
  • 33
  • 57