6

I have a sheet with roughly 12000 rows and 200 columns built up in a way that doesn't allow using it as a proper database. The first 8 columns have data I need, the last 180 columns have "address" headers and an "x" for rows where the column applies, "x" can appear in a row between 1 and 46 times.

Source table format: enter image description here

I want to loop through each row (only for the last 180 columns) and if a cell contains an "x" then copy values and append to a table in a new sheet:

  1. the first 8 cells from that row

  2. the header of the column marked by the "x", the header becomes cell 9

  3. if there is more than 1 "x" in a row, output should have a new line for every "x" with the a copy of the first 8 cells and the corresponding header in cell 9 [edit: added 3. for clarification]

  4. if there is no "x" in a row, that row can be ignored. The next available row in the output table should be populated with the data from the next source row that does have an "x". [edit 2: added 4. for clarification]

Result should look something like this: enter image description here

I'm no VBA expert and most rows just have 1 "x" so I started with using a formula to populate column 9 with the header of the column marked by "x":

=INDEX(R3C13:R3C192, SUMPRODUCT(MAX((RC[-184]:RC[-5]=R2C198)*(COLUMN(RC[-184]:RC[-5]))))-COLUMN(R[-1]C[-184])+1)

This gives me output for every first "x" on a row, but that leaves a couple of thousand rows with between 2 and 46 times "x".

I tried getting started on this with:

Sub Test()
Dim rw As Long, Cell As Range
For Each Cell In Sheets("1").Range("K:R")
rw = Cell.Row
 If Cell.Value = "x" Then
  Cell.EntireRow.Copy
   Sheets("2").Range("A" & rw).PasteSpecial xlPasteValues
 End If
Next
End Sub

Obviously this is a pretty rough start and does not give me:

  1. just copy the first 8 cells of the row

  2. copy the header of the "x" column to cell 9 (for the right row)

  3. It also does not append a new line for each "x" at the bottom of my new table.

I found some answers that are somewhat similar, such as: Loop through rows and columns Excel Macro VBA

But have not been able to make this work for my scenario. Any help would be much appreciated, thanks!

Improve this question
2
  • 1
    I did not know that you could change the column letters to numbers... neat! Commented Aug 23, 2019 at 13:51
  • 1
    @Marcucciboy2 it's called R1C1 notation instead of A1. It can be found in Excels settings or can be changed in VBA using Application.ReferenceStyle = xlR1C1 or set to A1 using Application.ReferenceStyle = xlA1 Commented Aug 23, 2019 at 14:38

1 Answer 1

Reset to default
2

Try this code, this sets the first 8 cells to only the rows that contain "x". 

Sub appendit()
Dim i, j, lrow, lcol As Long
Dim rCount, cCount As Long
 Dim addressString As String
Dim wb As Workbook
Dim ws As Worksheet
Dim newWs As Worksheet
Dim vMain As Variant




Set wb = ActiveWorkbook 'or whatever your workbook is
Set ws = wb.Sheets(1) 'or whatever your sheet is
wb.Sheets.Add(before:=wb.Sheets(1)).Name = "Output"
Set newWs = wb.Sheets("Output")
rCount = 1
With ws
lrow = .Cells(.Rows.Count, 1).End(xlUp).Row 'Load the data into an array for efficiency
lcol = .Cells(1, .Columns.Count).End(xlToLeft).Column
ReDim vMain(1 To lrow, 1 To lcol)
For i = 1 To lrow
    For j = 1 To lcol
        vMain(i, j) = .Cells(i, j)
    Next j
Next i
End With
With newWs
For i = 21 To UBound(vMain, 2) 'starting from the 21st column as the first 20 are not to be included.
    For j = 1 To UBound(vMain, 1)
        If vMain(j, i) = "x" Then
            .Cells(rCount, 1) = vMain(j, 1)
            .Cells(rCount, 2) = vMain(j, 2)
            .Cells(rCount, 3) = vMain(j, 3)
            .Cells(rCount, 4) = vMain(j, 4)
            .Cells(rCount, 5) = vMain(j, 5)
            .Cells(rCount, 6) = vMain(j, 6)
            .Cells(rCount, 7) = vMain(j, 7)
            .Cells(rCount, 8) = vMain(j, 8)
            .Cells(rCount, 9) = vMain(1, i)
            rCount = rCount + 1   
    End If
    Next j
Next i
End With
End Sub
Improve this answer
Sign up to request clarification or add additional context in comments.

8 Comments

Awesome, thanks! The only thing this does not give me is a new copy of the original row if a second "x" is found for the same row. The output currently only contains the result for the last "x" found in a row. I'm going to play with this some more later, this is a great starting point.
Im not quite sure I understand the issue can you please elaborate? Also if you feel like my answer sufficiently helped you, please click the check mark as answered.
Sure thing, take row 2 of my "source table format" as an example. It has an "x" in the column for address 1, and an "x" in the column for address 4. Your current code gives one output row for input row 2, the value of cell 9 is "address 4". My goal is that input row 2 gives two output rows, the first with "address 1" in cell 9, the second with "address 4" in cell 9. Cells 1 to 8 will be the same.
ANd what about if a row does NOT have an "x"; does that row need to be blank or just the next found x's cells 1-8?
BrakNicku is correct. Change the “Integer” to “Long” in the decelerations (Dim)
|

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.