Insert & fill rows based on values if found in columns

[aravindhan_3]

Hi,

I have the data in my input tab as below ( about 150 columns & about 3000 rows with data)




code TWCode1 TWCode2 TWCode3 TWCode4 TWCode5 TWCode10 MerCode1 MerCode2 MerCode3 MerCode4 MerCode5 RedCode1 RedCode2 RedCode3 RedCode4 RedCode5
1
2
3


assuming I have values in my input tab for code 3, TWCode1 as xxx, MerCode2 as yyy, RedCode5 as zzz & MerCode4 as www

in my output i need the result i need to update the below



No Codes Values
1
2
3 TWCode1 xxx
3 MerCode2 yyy
3 RedCode5 zzz
3 MerCode4 www

similarly i have to check for each of rows against columns and populate the data

can someone help me with any macros that can simplify this?

Regards
Arvind

[nilem]

Hi Arvind,
maybe so

Sub ertert()
Dim x, i&, j&, k&
x = Sheets("Sheet1").Range("A1").CurrentRegion.Value
ReDim y(1 To UBound(x) * UBound(x, 2), 1 To 3)
For i = 2 To UBound(x)
For j = 2 To UBound(x, 2)
If Len(x(i, j)) Then
k = k + 1
y(k, 1) = x(i, 1)
y(k, 2) = x(1, j)
y(k, 3) = x(i, j)
End If
Next j
Next i
Sheets("Sheet2").Range("A1:C1").Resize(k).Value = y()
End Sub

[aravindhan_3]

Hi,

This works perfectly! need to modify a bit on this
for example in this case its looking for all columns

TWCode1 TWCode2 TWCode3 TWCode4 TWCode5 TWCode10 MerCode1 MerCode2 MerCode3 MerCode4 MerCode5 RedCode1 RedCode2 RedCode3 RedCode4 RedCode5 and getting data,

sometimes i might have to ignore some of the columns for example, I want to ignore all columns except RedCode1, MerCode4 etc
so what I can do is create a list of column names that i want to check in a different sheet, and create a name called "Criteria", so the macro will look only those columns and retrieve data. do you think its possible?

Regards
Arvind

[nilem]

try this

Sub ertert()
Dim x, i&, j&, k&, NeededColumns$

x = Sheets("Sheet1").Range("A1").CurrentRegion.Value
With Sheets("Sheet3")
NeededColumns = Join(Application.Transpose(.Range("A1", .Cells(Rows.Count, 1).End(xlUp))))
End With
ReDim y(1 To UBound(x) * UBound(x, 2), 1 To 3)

For j = 2 To UBound(x, 2)
If InStr(NeededColumns, x(1, j)) Then
For i = 2 To UBound(x)
If Len(x(i, j)) Then
k = k + 1
y(k, 1) = x(i, 1)
y(k, 2) = x(1, j)
y(k, 3) = x(i, j)
End If
Next i
End If
Next j
With Sheets("Sheet2")
.UsedRange.Offset(1).ClearContents
.Range("A1:C1").Resize(k).Value = y()
.Activate
End With
End Sub

[aravindhan_3]

Hi,
suuuuuuuuuper, it works.

few things:-
1. I think when its looking up the columns from sheet 3, its performs contain function
for eg, in sheet 3 i have mentioned the columns western management code 1
but in my input tab ( sheet1) i have column called western management , western management code 1 & western management code 2
the macro is looking for juster western management and giving me output instead of western management code1 & 2

2. how do i change this code to get result in my output as
code in column 1 & other data not in B & C but the column that I define may be Z & W

Regards
Arvind

[nilem]

I think your example file has helped solve your problem

[aravindhan_3]

i Nilem,
sorry due to security reason, i will not be able to upload any files,
i will break down the question.
1. in the above code it looks up values from column A ( Code ) and if finds values for the columns then it copies the results of this


y(k, 3) = x(i, j)
y(k, 2) = x(1, j)
y(k, 3) = x(i, j)
and pastes in sheet 2
.Range("A1:C1").Resize(k).Value = y()
so instead of this, let the Nos be pasted in A1, codes in column D & Values in Column F ( it has to be dynamic so that i can change in the code )
something like this


a(k, 3) = x(i, j)

b(k, 2) = x(1, j)

c(k, 3) = x(i, j)
......
.Range("A1.Value = a()
.Range("D1.Value = b()
.Range("F1Value = c()

Thanks
arvind

[nilem]

Sub ertert()
Dim x, i&, j&, k&, NeededColumns$

x = Sheets("Sheet1").Range("A1").CurrentRegion.Value
With Sheets("Sheet3")
NeededColumns = "~" & Join(Application.Transpose(.Range("A1", .Cells(Rows.Count, 1).End(xlUp))), "~") & "~"
End With
ReDim y(1 To UBound(x) * UBound(x, 2), 1 To 3)

For j = 2 To UBound(x, 2)
If InStr(NeededColumns, "~" & x(1, j) & "~") Then
For i = 2 To UBound(x)
If Len(x(i, j)) Then
k = k + 1
y(k, 1) = x(i, 1)
y(k, 2) = x(1, j)
y(k, 3) = x(i, j)
End If
Next i
End If
Next j
With Sheets("Sheet2")
.UsedRange.Offset(1).ClearContents
.Range("A1").Resize(k).Value = y()
.Range("D1").Resize(k).Value = Application.Index(y(), 0, 2)
.Range("F1").Resize(k).Value = Application.Index(y(), 0, 3)
.Activate
End With
End Sub

[aravindhan_3]

Hi,
Thanks for your help, the above works fine, but all of a sudden i get an error message saying Run time error 1004 - application-defined error or object-defined error . in line

.Range("D1").Resize(k).Value = Application.Index(y(), 0, 2)

can you please help
Regards
Arvind