Search through columns and find specific text and replace that text with header column

**adamzee** · 10-08-2014, 02:48 AM

I need help with a macro that searches through columns of a table and picks up the letter x and replaces the letter x with the header of that particular column.
Once the letter x has been replaced with the header, the structure of the data changes from a table to list the items that have changed from x to the headers downwards.

I have attached an example file.

Any help would be appreciated.

**:) Sixthsense :)** · 10-08-2014, 03:12 AM

Run this code from the output sheet

How to install your new code

Copy the Excel VBA code
Select the workbook in which you want to store the Excel VBA code
Press Alt+F11 to open the Visual Basic Editor
Choose Insert > Module
Edit > Paste the macro into the module that appeared
Close the VBEditor
Save your workbook (Excel 2007+ select a macro-enabled file format, like *.xlsm)

Sub GetOutput()
Dim rSku As Range, i As Long, r As Range, lRw As Long

Set rSku = Application.InputBox("Select SKU data without Header", "Sku Data Range Only", "=Data!D2:I11", , , , , 8)

Application.ScreenUpdating = False

With rSku
    For i = 1 To .Rows.Count
        For Each r In .Rows(i).Cells
            If UCase(r.Value) = "X" Then
                lRw = Cells(Rows.Count, "A").End(xlUp).Row + 1
                Range("A" & lRw & ":C" & lRw).Value = .Rows(i).Cells(1).Offset(, -3).Resize(, 3).Value
                Range("D" & lRw).Value = ThisWorkbook.Sheets(r.Parent.Name).Cells(1, r.Column).Value
            End If
        Next r
    Next i
End With

Application.ScreenUpdating = True

End Sub

To run the Excel VBA code:

Press Alt-F8 to open the macro list
Select a macro in the list
Click the Run button

**Kamboj** · 10-08-2014, 03:50 AM

with the help of this macro you can arrange your data excel file attached.

**JOHN H. DAVIS** · 10-08-2014, 06:34 AM

Another:

Sub adamzee()
Dim rcell As Range
With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
End With
For Each rcell In Sheets("Data").UsedRange.offset(1)
    If rcell.Value = "x" Then
        Cells(rcell.Row, "A").Copy Sheets("Output").Range("A" & Rows.count).End(3)(2)
        Cells(rcell.Row, "B").Copy Sheets("Output").Range("B" & Rows.count).End(3)(2)
        Cells(rcell.Row, "C").Copy Sheets("Output").Range("C" & Rows.count).End(3)(2)
        Cells(1, rcell.Column).Copy Sheets("Output").Range("D" & Rows.count).End(3)(2)
    End If
Next rcell
Sheets("Output").Cells(1, 1) = "State"
Sheets("Output").Cells(1, 2) = "Store name"
Sheets("Output").Cells(1, 3) = "Store number"
Sheets("Output").Cells(1, 4) = "SKU"
With Application
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
End With
End Sub

PS: Created a Sheets Output to memic the results sheet.

**apo** · 10-08-2014, 07:54 AM

Here's another...

Private Sub CommandButton1_Click()
    Dim x, z, j As Long, i As Long, ii As Long
    x = Range("A1").CurrentRegion
    ReDim z(1 To Application.CountIf(Range("A1").CurrentRegion, "x"), 1 To 4)
    j = 1
    For i = 2 To UBound(x)
        For ii = 4 To UBound(x, 2)
            If Application.Index(x, i, ii) = "x" Then
                z(j, 1) = x(i, 1): z(j, 2) = x(i, 2): z(j, 3) = x(i, 3)
                z(j, 4) = Application.Index(x, 1, ii)
                j = j + 1
            End If
        Next ii
    Next i
    With Sheets("Output from macro")
        .Range("A1").Resize(, 4).Value = Array("State", "Store Name", "Store Number", "SKU")
        .Range("A2").Resize(UBound(z), 4).Value = z
        .Columns.AutoFit
        .Select
    End With
End Sub

**adamzee** · 10-09-2014, 11:59 PM

Thanks for everyone's help! Perfect

Search through columns and find specific text and replace that text with header column

LinkBack

Thread Tools

Rate This Thread

Display

Hybrid View

Search through columns and find specific text and replace that text with header column

Re: Search through columns and find specific text and replace that text with header column

Re: Search through columns and find specific text and replace that text with header column

Re: Search through columns and find specific text and replace that text with header column

Re: Search through columns and find specific text and replace that text with header column

Re: Search through columns and find specific text and replace that text with header column

Thread Information

Users Browsing this Thread

Similar Threads

Search rows to find specific text and move to a different column ?

Macro to find header information and replace with specific text

[SOLVED] VBA to Search a Text String, Find a Value listed in another column and replace the text

Need a Macro 2 search rows for text and replace with column header...

macro to replace specific data with column header text

Bookmarks

Bookmarks

Posting Permissions